XWorkstation.st
author Stefan Vogel <sv@exept.de>
Thu, 25 Sep 2014 23:16:16 +0200
branchdelegated_gc
changeset 6573 fc119adc7582
parent 6472 5b21ff383a12
child 6635 969f60d974fd
permissions -rw-r--r--
class: XWorkstation added: #isX11Platform
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
     2
COPYRIGHT (c) 1989 by Claus Gittinger
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
     3
              All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
3200
f92ccb3cac8e Care for Num_Lock in any of the mod1- or mod2-keys.
Stefan Vogel <sv@exept.de>
parents: 3177
diff changeset
    12
"{ Package: 'stx:libview' }"
f92ccb3cac8e Care for Num_Lock in any of the mod1- or mod2-keys.
Stefan Vogel <sv@exept.de>
parents: 3177
diff changeset
    13
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    14
DeviceWorkstation subclass:#XWorkstation
6169
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    15
	instanceVariableNames:'hasShapeExtension hasShmExtension hasDPSExtension
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    16
		hasMbufExtension hasXVideoExtension hasSaveUnder hasPEXExtension
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    17
		hasImageExtension hasInputExtension hasXineramaExtension
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    18
		hasRenderExtension hasXftLibrary ignoreBackingStore blackpixel
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    19
		whitepixel atoms protocolsAtom deleteWindowAtom saveYourselfAtom
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    20
		quitAppAtom primaryAtom clipboardAtom stringAtom wmStateAtom
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    21
		motifWMHintsAtom listOfXFonts buttonsPressed eventRootX
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    22
		eventRootY displayName eventTrace dispatchingExpose rgbVisual
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    23
		rgbaVisual virtualRootId rootId altModifierMask metaModifierMask
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    24
		lastEventTime rawMonitorBounds monitorBounds lastButtonPressTime
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    25
		deviceIOTimeoutErrorSignal activateOnClick rawKeySymTranslation
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    26
		selectionOwner clipboardSelectionTime primarySelectionTime
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    27
		selectionFetchers selectionHandlers preWaitAction xlibTimeout
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    28
		xlibTimeoutForWindowCreation hasConnectionBroken uniqueDeviceID
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    29
		stxDeviceAtom uuidAtom primaryBuffer windowGroupWindow
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    30
		maxOperationsUntilFlush operationsUntilFlush'
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    31
	classVariableNames:'RawKeySymTranslation ConservativeSync MaxStringLength
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
    32
		DefaultXLibTimeout DefaultXLibTimeoutForWindowCreation
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
    33
		ErrorDBCache'
6169
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    34
	poolDictionaries:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    35
	category:'Interface-Graphics'
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
    36
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    37
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
    38
Object subclass:#SelectionFetcher
6169
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    39
	instanceVariableNames:'sema message display drawableID selectionID propertyID targetID
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    40
		buffer done incremental'
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    41
	classVariableNames:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    42
	poolDictionaries:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    43
	privateIn:XWorkstation
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
    44
!
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
    45
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
    46
SimpleView subclass:#WindowGroupWindow
6169
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    47
	instanceVariableNames:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    48
	classVariableNames:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    49
	poolDictionaries:''
426e8838363a class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6160
diff changeset
    50
	privateIn:XWorkstation
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
    51
!
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
    52
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    53
DeviceGraphicsContext subclass:#X11GraphicsContext
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    54
	instanceVariableNames:'useXftFont xftDrawId'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    55
	classVariableNames:''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    56
	poolDictionaries:''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    57
	privateIn:XWorkstation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    58
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
    59
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
    60
!XWorkstation primitiveDefinitions!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    61
%{
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    62
4090
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
    63
#define SUPPORT_MOTIF_WM_HINTS
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
    64
1062
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
    65
#ifdef LINUX
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
    66
# define SHM
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
    67
#endif
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
    68
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    69
#define COUNT_RESOURCES
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    70
#ifdef COUNT_RESOURCES
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    71
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    72
static int __cnt_color = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    73
static int __cnt_bitmap = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    74
static int __cnt_view = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    75
static int __cnt_gc = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    76
static int __cnt_cursor = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    77
static int __cnt_font = 0;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    78
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    79
#endif
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
    80
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
    81
/*
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
    82
 * x does a typedef Time - I need Object Time ...
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
    83
 */
2791
97ae9d3d44e4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2777
diff changeset
    84
#undef Time
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    85
#define Time XTime
48194c26a46c Initial revision
claus
parents:
diff changeset
    86
391
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    87
/*
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    88
 * x does a #define True / False
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    89
 * we are lucky - the ST/X True/False are not needed
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    90
 */
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    91
#undef True
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    92
#undef False
d3cad7c15ae2 well well well - do a sync in eventPending
Claus Gittinger <cg@exept.de>
parents: 386
diff changeset
    93
37
c2dc1832c0f1 *** empty log message ***
claus
parents: 36
diff changeset
    94
#ifdef memset
c2dc1832c0f1 *** empty log message ***
claus
parents: 36
diff changeset
    95
# undef memset
c2dc1832c0f1 *** empty log message ***
claus
parents: 36
diff changeset
    96
#endif
c2dc1832c0f1 *** empty log message ***
claus
parents: 36
diff changeset
    97
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
    98
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    99
#include <stdio.h>
5989
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   100
6041
cd2da50a737c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6032
diff changeset
   101
#if defined(__osx__)
5989
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   102
# include <malloc/malloc.h>
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   103
extern void *malloc();
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   104
#else
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   105
# ifndef FREEBSD
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   106
#  include <malloc.h>
Claus Gittinger <cg@exept.de>
parents: 5985
diff changeset
   107
# endif
5528
42447013fbc6 freebsd
Michael Beyl <mb@exept.de>
parents: 5525
diff changeset
   108
#endif
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   109
#include <X11/Xlib.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   110
#include <X11/Xutil.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   111
#include <X11/Xatom.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   112
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   113
#define XK_MISCELLANY
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   114
#include <X11/keysymdef.h>
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   115
277
eb67c44da084 testing new inline-expression feature of stc - no real change
Claus Gittinger <cg@exept.de>
parents: 268
diff changeset
   116
#include <X11/cursorfont.h>
eb67c44da084 testing new inline-expression feature of stc - no real change
Claus Gittinger <cg@exept.de>
parents: 268
diff changeset
   117
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   118
#ifdef LINUX
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   119
# include <sys/socket.h>
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   120
#endif
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   121
2422
6bffcb4c8360 changes for egcs (__new in stdio)
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   122
90
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   123
/*
847
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   124
 * this define suppresses XAllocColor/XFreeColor on
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   125
 * TrueColor systems - I am not certain, if this is
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   126
 * always legal to do (it works with XFree servers).
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   127
 */
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   128
#define QUICK_TRUE_COLORS
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   129
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
   130
/*
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   131
 * shape support works; enabled by -DSHAPE in makefile
48194c26a46c Initial revision
claus
parents:
diff changeset
   132
 * see RoundClock and RoundGlobe examples
48194c26a46c Initial revision
claus
parents:
diff changeset
   133
 */
48194c26a46c Initial revision
claus
parents:
diff changeset
   134
#ifdef SHAPE
48194c26a46c Initial revision
claus
parents:
diff changeset
   135
# include <X11/extensions/shape.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   136
#endif
48194c26a46c Initial revision
claus
parents:
diff changeset
   137
48194c26a46c Initial revision
claus
parents:
diff changeset
   138
/*
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   139
 * shared memory extension access is currently not supported
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   140
 * (only query is implemented)
48194c26a46c Initial revision
claus
parents:
diff changeset
   141
 */
48194c26a46c Initial revision
claus
parents:
diff changeset
   142
#ifdef SHM
48194c26a46c Initial revision
claus
parents:
diff changeset
   143
# include <X11/extensions/XShm.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
#endif
48194c26a46c Initial revision
claus
parents:
diff changeset
   145
48194c26a46c Initial revision
claus
parents:
diff changeset
   146
/*
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   147
 * multiBuffer extension access is currently not supported
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   148
 * (only query is implemented)
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   149
 */
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   150
#ifdef MBUF
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   151
# include <X11/extensions/multibuf.h>
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   152
#endif
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   153
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   154
/*
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   155
 * XVideo extension access is currently not supported
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   156
 * (only query is implemented)
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   157
 */
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   158
#ifdef XVIDEO
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   159
# include <X11/extensions/Xv.h>
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   160
#endif
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   161
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   162
/*
186
claus
parents: 180
diff changeset
   163
 * PEX extension - if available
claus
parents: 180
diff changeset
   164
 */
claus
parents: 180
diff changeset
   165
#ifdef PEX5
claus
parents: 180
diff changeset
   166
# include <PEX5/PEX.h>
claus
parents: 180
diff changeset
   167
#endif
claus
parents: 180
diff changeset
   168
claus
parents: 180
diff changeset
   169
/*
claus
parents: 180
diff changeset
   170
 * XImage extension - if available
claus
parents: 180
diff changeset
   171
 */
claus
parents: 180
diff changeset
   172
#ifdef XIE
claus
parents: 180
diff changeset
   173
# include <X11/extensions/XIE.h>
claus
parents: 180
diff changeset
   174
#endif
claus
parents: 180
diff changeset
   175
5865
35046414f412 added: #queryXINERAMAExtension
Stefan Vogel <sv@exept.de>
parents: 5864
diff changeset
   176
#ifdef XINERAMA
35046414f412 added: #queryXINERAMAExtension
Stefan Vogel <sv@exept.de>
parents: 5864
diff changeset
   177
# include <X11/extensions/Xinerama.h>
35046414f412 added: #queryXINERAMAExtension
Stefan Vogel <sv@exept.de>
parents: 5864
diff changeset
   178
#endif
35046414f412 added: #queryXINERAMAExtension
Stefan Vogel <sv@exept.de>
parents: 5864
diff changeset
   179
186
claus
parents: 180
diff changeset
   180
/*
6159
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   181
 * xft library (based on RENDER extension) - if available
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   182
 */
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   183
#ifdef XFT
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   184
# include <X11/Xft/Xft.h>
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   185
# include <X11/extensions/Xrender.h>
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   186
# include <X11/extensions/render.h>
6159
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   187
#endif
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   188
d4e463e0c56c preps for xft
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
   189
/*
90
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   190
 * when I have more time to check it out, I will support display-PS
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   191
 */
48194c26a46c Initial revision
claus
parents:
diff changeset
   192
#ifdef DPS
48194c26a46c Initial revision
claus
parents:
diff changeset
   193
# ifdef sgi
48194c26a46c Initial revision
claus
parents:
diff changeset
   194
#  include <X11/extensions/XDPS.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   195
#  include <X11/extensions/XDPSlib.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   196
#  include <X11/extensions/dpsXclient.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   197
# else
48194c26a46c Initial revision
claus
parents:
diff changeset
   198
#  include <DPS/XDPS.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   199
#  include <DPS/XDPSlib.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   200
#  include <DPS/dpsXclient.h>
48194c26a46c Initial revision
claus
parents:
diff changeset
   201
# endif
48194c26a46c Initial revision
claus
parents:
diff changeset
   202
#endif
48194c26a46c Initial revision
claus
parents:
diff changeset
   203
1898
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   204
#if defined(someMachine)
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   205
/*
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   206
 * if nformats cannot be found in the Display structure ...
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   207
 */
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   208
# define NO_PRIVATE_DISPLAY_ACCESS
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   209
#endif
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   210
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
   211
#if defined(IRIX5) || defined(__VMS) || (XlibSpecificationRelease == 6)
90
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   212
  /*
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   213
   * accessing private data in Display ... sorry
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   214
   */
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   215
# define DISPLAYACCESS(d) ((_XPrivDisplay)d)
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   216
#else
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   217
# define DISPLAYACCESS(d) d
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   218
#endif
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   219
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   220
/*
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   221
 * some defines - tired of typing ...
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   222
 */
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   223
#define __DisplayVal(o)      (Display *)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   224
#define __DrawableVal(o)     (Drawable)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   225
#define __WindowVal(o)       (Window)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   226
#define __PixmapVal(o)       (Pixmap)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   227
#define __GCVal(o)           (GC)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   228
#define __CursorVal(o)       (Cursor)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   229
#define __FontVal(o)         (XFontStruct *)(__externalAddressVal(o))
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   230
#define __DPSContextVal(o)   (DPSContext)(__externalAddressVal(o))
207
9124817bbb03 use new c-pointer wrapper macros (based on externalAddress)
Claus Gittinger <cg@exept.de>
parents: 206
diff changeset
   231
3693
b01b0cd76a61 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3670
diff changeset
   232
#define __MKATOMOBJ(a)       __MKSMALLINT(a)   /* add STORE macro if ever changed */
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   233
#define __AtomVal(o)         __intVal(o)
211
b5f925b56e8e Fix example.
Stefan Vogel <sv@exept.de>
parents: 208
diff changeset
   234
#define __isAtomID(o)        __isSmallInteger(o)
b5f925b56e8e Fix example.
Stefan Vogel <sv@exept.de>
parents: 208
diff changeset
   235
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   236
#define myDpy                __DisplayVal(__INST(displayId))
4409
fdb60a1f78da remember broken connection
Claus Gittinger <cg@exept.de>
parents: 4401
diff changeset
   237
#define ISCONNECTED          ((__INST(displayId) != nil) && (__INST(hasConnectionBroken) != nil))
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   238
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
   239
#ifdef __VMS__
1899
de1eb2a3318e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1898
diff changeset
   240
# include "vms_Xnames.h"
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
   241
#endif
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
   242
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   243
void __XTimeoutErrorHandler();
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   244
int __XErrorHandler__();
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   245
int __XIOErrorHandler__();
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   246
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   247
/*
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   248
 * these two macros should be placed around X-lib calls,
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   249
 * which may block due to a broken connection.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   250
 * They setup/remove a VM-timeout which raises an exception
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   251
 * after xlibTimeout seconds.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   252
 * This exception will shutDown the connection.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   253
 * Q: is this a good idea for the local display ?
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   254
 */
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   255
#define __ENTER_XLIB(whichTimeout)   \
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   256
    { \
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   257
        __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)__XTimeoutErrorHandler; \
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   258
        __blockingPrimitiveTimeoutArg__ = self; \
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   259
        __blockingPrimitiveTimeout__ = __intVal(__INST(whichTimeout)) * 1000; \
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
   260
    } {
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   261
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
   262
#define LEAVE_XLIB()   \
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   263
    { \
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   264
        __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)0; \
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   265
        __blockingPrimitiveTimeoutArg__ = nil; \
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   266
        __blockingPrimitiveTimeout__ = 0; \
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
   267
    } }
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   268
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   269
#define ENTER_XLIB()   __ENTER_XLIB(xlibTimeout)
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   270
#define ENTER_XLIB2()  __ENTER_XLIB(xlibTimeoutForWindowCreation)
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   271
4090
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   272
#ifdef SUPPORT_MOTIF_WM_HINTS
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   273
# ifdef SOME_MACHINE
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   274
#  include <anIncludeFileWhichDefinesTheStuffBelow>
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   275
# endif
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   276
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   277
# ifndef MWM_HINTS_FUNCTIONS
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   278
#  define MWM_HINTS_FUNCTIONS       (1L << 0)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   279
#  define MWM_HINTS_DECORATIONS     (1L << 1)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   280
#  define MWM_HINTS_INPUT_MODE      (1L << 2)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   281
#  define MWM_HINTS_STATUS          (1L << 3)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   282
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   283
#  define MWM_FUNC_ALL              (1L << 0)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   284
#  define MWM_FUNC_RESIZE           (1L << 1)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   285
#  define MWM_FUNC_MOVE             (1L << 2)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   286
#  define MWM_FUNC_MINIMIZE         (1L << 3)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   287
#  define MWM_FUNC_MAXIMIZE         (1L << 4)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   288
#  define MWM_FUNC_CLOSE            (1L << 5)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   289
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   290
#  define MWM_INPUT_MODELESS                      0
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   291
#  define MWM_INPUT_PRIMARY_APPLICATION_MODAL     1
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   292
#  define MWM_INPUT_SYSTEM_MODAL                  2
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   293
#  define MWM_INPUT_FULL_APPLICATION_MODAL        3
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   294
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   295
#  define MWM_DECOR_NONE            0
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   296
#  define MWM_DECOR_ALL             (1L << 0)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   297
#  define MWM_DECOR_BORDER          (1L << 1)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   298
#  define MWM_DECOR_RESIZEH         (1L << 2)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   299
#  define MWM_DECOR_TITLE           (1L << 3)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   300
#  define MWM_DECOR_MENU            (1L << 4)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   301
#  define MWM_DECOR_MINIMIZE        (1L << 5)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   302
#  define MWM_DECOR_MAXIMIZE        (1L << 6)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   303
# endif
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   304
#endif /* SUPPORT_MOTIF_WM_HINTS */
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   305
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   306
/*
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   307
 * openlook hints are not supported yet
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   308
 * - noone needs them anymore ;-(
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   309
 */
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   310
#ifdef SUPPORT_OPENLOOCK_WM_HINTS
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   311
# ifdef SOME_MACHINE
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   312
#  include <anIncludeFileWhichDefinesTheStuffBelow>
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   313
# endif
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   314
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   315
# ifndef OL_DECOR_CLOSE
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   316
#  define OL_DECOR_CLOSE            (1L << 0)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   317
#  define OL_DECOR_RESIZEH          (1L << 1)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   318
#  define OL_DECOR_HEADER           (1L << 2)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   319
#  define OL_DECOR_ICON_NAME        (1L << 3)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   320
#  define OL_DECOR_ALL              (OL_DECOR_CLOSE | OL_DECOR_RESIZEH | OL_DECOR_HEADER | OL_DECOR_ICON_NAME)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   321
#  define OL_ANY_HINTS              (1L << 7)
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   322
# endif
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   323
#endif /* SUPPORT_OPENLOOCK_WM_HINTS */
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
   324
4082
cb6eb58e8311 set MWM-Decoration-Hints
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
   325
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   326
%}
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   327
! !
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   328
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   329
!XWorkstation primitiveVariables!
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   330
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   331
/*
146
claus
parents: 145
diff changeset
   332
 * remembered info from private error handler
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   333
 */
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   334
static char lastErrorMsg[128] = "";
1888
05f4db77cc91 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1887
diff changeset
   335
static unsigned INT lastRequestCode = 0;
05f4db77cc91 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1887
diff changeset
   336
static unsigned INT lastMinorCode = 0;
05f4db77cc91 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1887
diff changeset
   337
static unsigned INT lastResource = 0;
129
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   338
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   339
static int __debug__ = 0;
3468
b7e913629327 printf -> fprintf
Claus Gittinger <cg@exept.de>
parents: 3467
diff changeset
   340
4723
ad10f05ff89b printf -> console_printf
Claus Gittinger <cg@exept.de>
parents: 4711
diff changeset
   341
#define DPRINTF(x)      if (__debug__) { console_printf x; }
3468
b7e913629327 printf -> fprintf
Claus Gittinger <cg@exept.de>
parents: 3467
diff changeset
   342
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   343
%}
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   344
! !
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   345
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   346
!XWorkstation primitiveFunctions!
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   347
%{
1062
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   348
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   349
/*
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   350
 * some systems need a dummy reference to force the linker
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   351
 * to include that stuff. Should be #ifdef'd ...
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   352
 */
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   353
#ifndef ELF
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   354
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   355
# ifdef __GNUC__
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   356
VOLATILE
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   357
# endif
1081
f7d19178fb2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1080
diff changeset
   358
static
1062
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   359
dummyToForceLoading() {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   360
        XCreateSimpleWindow(0, 0, 0, 0, 0, 0, 0, 0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   361
        XCloseDisplay(0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   362
        XCreateImage(0, 0, 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   363
        XSetWindowColormap(0, 0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   364
        XQueryColors(0,0,0,0);
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   365
# ifdef SHM
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   366
        XShmAttach(0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   367
        XShmCreateImage(0, 0, 0, 0, 0, 0, 0 ,0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   368
        XShmDetach(0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   369
        XShmPutImage(0, 0, 0, 0 , 0,0,0,0,0,0,0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   370
        shmctl(0,0,0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   371
        fgetc(0);
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   372
# endif
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   373
}
1062
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   374
#endif
2a5d50022c96 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   375
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   376
#undef __myInstPtr
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   377
#define __myInstPtr(obj) ((struct __XWorkstation_struct *)(obj))
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   378
18
9ffa3bf0ee58 *** empty log message ***
claus
parents: 12
diff changeset
   379
/*
144
claus
parents: 143
diff changeset
   380
 * catch X-errors and forward as errorInterrupt:#DisplayError,
claus
parents: 143
diff changeset
   381
 * (which itself invokes my handler and optionally raises an exceptionSignal)
90
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
   382
 * the implementation below is somewhat wrong: it will
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   383
 * report all errors for Display, even though there could be
162
claus
parents: 160
diff changeset
   384
 * more than one display connection. (being fixed, new errorInterrupt mechanism
claus
parents: 160
diff changeset
   385
 * allows passing an additional argument, which is the displayID ...)
18
9ffa3bf0ee58 *** empty log message ***
claus
parents: 12
diff changeset
   386
 */
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   387
int
12
9f0995fac1fa *** empty log message ***
claus
parents: 7
diff changeset
   388
__XErrorHandler__(dpy, event)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   389
    Display *dpy;
48194c26a46c Initial revision
claus
parents:
diff changeset
   390
    XErrorEvent *event;
48194c26a46c Initial revision
claus
parents:
diff changeset
   391
{
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   392
    XGetErrorText(dpy, event->error_code, lastErrorMsg, 127);
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   393
    lastErrorMsg[127] = '\0';
1060
bc581886fe8f dont interrupt immediately; use superclasses colorName processing as fallBack
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
   394
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   395
    if (lastErrorMsg[0] == '\0') {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   396
        sprintf(lastErrorMsg, "code: %d", event->error_code);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   397
    }
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   398
    lastRequestCode = event->request_code;
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   399
    lastMinorCode = event->minor_code;
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   400
    lastResource = event->resourceid;
911
c934a49174e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 898
diff changeset
   401
    if ((event->error_code == BadWindow) && (lastRequestCode == 4) && (lastMinorCode == 0)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   402
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   403
         * this is a BadWindow error for X_DestroyWindow.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   404
         * ignore it here, since it results from the GC freeing windows
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   405
         * in non bottom-up window order.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   406
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   407
        return 0;
911
c934a49174e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 898
diff changeset
   408
    }
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   409
4640
edde8a16e07d Fix classvar refs in primitive functions.
Stefan Vogel <sv@exept.de>
parents: 4636
diff changeset
   410
    if (@global(DeviceWorkstation:ErrorPrinting) == true) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   411
        console_fprintf(stderr, "XWorkstation [error]: x-error caught maj=%d (0x%x) min=%d (0x%x) resource=%"_lx_"\n",
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   412
                        event->request_code, event->request_code,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   413
                        event->minor_code, event->minor_code, (INT)(event->resourceid));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   414
        console_fprintf(stderr, "XWorkstation [error]: x-error message is [%d] '%s'\n",
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   415
                        event->error_code, lastErrorMsg);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   416
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   417
#if 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   418
    // cg: should no longer be needed - librun no longer sends an errorInterrupt while running on C-stack
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   419
#ifdef XFT
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   420
    if ((strncmp(lastErrorMsg, "RenderBadPicture", 16) == 0)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   421
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   422
         * this is a RenderBadPicture error from XFT drawing.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   423
         * ignore it for now, as this is due to an incomplete implementation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   424
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   425
        console_fprintf(stderr, "XWorkstation [info]: x-error ignored\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   426
        return 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   427
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   428
#endif
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   429
#endif
1990
201f8ecfdad3 device timeout handling
Claus Gittinger <cg@exept.de>
parents: 1979
diff changeset
   430
    __errorInterruptWithIDAndParameter__(@symbol(DisplayError), __MKEXTERNALADDRESS(dpy));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   431
    return 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
   432
}
48194c26a46c Initial revision
claus
parents:
diff changeset
   433
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   434
/*
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   435
 * much like the above, but for IO Errors;
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   436
 * forwarded as errorInterrupt:#DisplayIOError,
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   437
 * In single display apps, handling those here does not
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   438
 * really make sense (except, for a controlled cleanup).
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   439
 * However, in multiDisplay apps, a single broken
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   440
 * connection should not affect the other users.
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   441
 */
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   442
int
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   443
__XIOErrorHandler__(dpy)
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   444
    Display *dpy;
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   445
{
4640
edde8a16e07d Fix classvar refs in primitive functions.
Stefan Vogel <sv@exept.de>
parents: 4636
diff changeset
   446
    if (@global(DeviceWorkstation:ErrorPrinting) == true) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   447
        console_fprintf(stderr, "XWorkstation [error]: I/O error\n");
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   448
    }
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   449
    __immediateErrorInterruptWithIDAndParameter__(@symbol(DisplayIOError),
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   450
                                                  __MKEXTERNALADDRESS(dpy));
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   451
3207
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   452
#if 0
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   453
    /*
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   454
     * don't do this.
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   455
     * This error is called asynchronously, and the wrong process may be terminated
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   456
     */
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   457
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   458
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   459
    /*
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   460
     * if we return from the error interrupt ...
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   461
     */
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   462
    __internalError("unhandled display I/O error");
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   463
    __terminateProcess(0);      /* soft terminate */
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   464
    __terminateProcess(1);      /* hard terminate */
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   465
    /* never reached */
3207
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   466
#endif
df242f652d1f More error handling
Stefan Vogel <sv@exept.de>
parents: 3206
diff changeset
   467
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   468
    return 0;
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   469
}
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   470
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   471
/*
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   472
 * timeout error in case of Xlib request timeout.
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   473
 * forwarded as errorInterrupt:#DisplayIOTimeoutError,
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   474
 * This is generated synthetically by the VM if the
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   475
 * timeoutHandler has been set.
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   476
 */
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   477
void
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   478
__XTimeoutErrorHandler(displayDeviceInst)
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   479
    OBJ displayDeviceInst;
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   480
{
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   481
    if ((displayDeviceInst == @global(MainDisplay))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   482
        || (displayDeviceInst == @global(DeviceWorkstation:DefaultScreen))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   483
        console_fprintf(stderr, "XWorkstation [error]: keep display connection for master display after X11 timeout (no shutdown)\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   484
        return;
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   485
    }
4640
edde8a16e07d Fix classvar refs in primitive functions.
Stefan Vogel <sv@exept.de>
parents: 4636
diff changeset
   486
    if (@global(DeviceWorkstation:ErrorPrinting) == true) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   487
        console_fprintf(stderr, "XWorkstation [error]: X11 request timeout dpy=%"_lx_"\n", (INT)displayDeviceInst);
4636
6c715971d212 Fix display timeout error handling
Stefan Vogel <sv@exept.de>
parents: 4635
diff changeset
   488
    }
4409
fdb60a1f78da remember broken connection
Claus Gittinger <cg@exept.de>
parents: 4401
diff changeset
   489
    __OINST(displayDeviceInst, hasConnectionBroken) = true;
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   490
4635
ad449b8058fe Fix for __XTimeoutErrorHandler__: __PROTECT__(displayDeviceInst)
Stefan Vogel <sv@exept.de>
parents: 4631
diff changeset
   491
    __PROTECT__(displayDeviceInst);
1990
201f8ecfdad3 device timeout handling
Claus Gittinger <cg@exept.de>
parents: 1979
diff changeset
   492
    __immediateErrorInterruptWithIDAndParameter__(@symbol(DisplayIOTimeoutError), displayDeviceInst);
4635
ad449b8058fe Fix for __XTimeoutErrorHandler__: __PROTECT__(displayDeviceInst)
Stefan Vogel <sv@exept.de>
parents: 4631
diff changeset
   493
    __UNPROTECT__(displayDeviceInst);
3205
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   494
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   495
    /*
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   496
     * if we return from the error interrupt ...
8648fa72c0af Fix error handling (#displayTimoutError)
Stefan Vogel <sv@exept.de>
parents: 3203
diff changeset
   497
     */
3206
61414144918b More error handling
Stefan Vogel <sv@exept.de>
parents: 3205
diff changeset
   498
    if (__OINST(displayDeviceInst, displayId) != nil) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   499
        __internalError("unhandled X11 display timeout error");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   500
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   501
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   502
         * the current process failed to do an X11 request.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   503
         * Terminate it!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   504
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   505
        __terminateProcess(0);      /* soft terminate */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   506
        __terminateProcess(1);      /* hard terminate */
3206
61414144918b More error handling
Stefan Vogel <sv@exept.de>
parents: 3205
diff changeset
   507
    }
1579
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   508
}
692c2f62d94e handle broken X-connection smoothly
Claus Gittinger <cg@exept.de>
parents: 1576
diff changeset
   509
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   510
%}
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   511
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   512
1171
a40ea3d796fd newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   513
!XWorkstation class methodsFor:'documentation'!
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   514
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   515
copyright
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   516
"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   517
COPYRIGHT (c) 1989 by Claus Gittinger
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   518
              All Rights Reserved
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   519
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   520
 This software is furnished under a license and may be used
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   521
 only in accordance with the terms of that license and with the
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   522
 inclusion of the above copyright notice.   This software may not
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   523
 be provided or otherwise made available to, or used by, any
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   524
 other person.  No title to or ownership of the software is
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   525
 hereby transferred.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   526
"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   527
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   528
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   529
documentation
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   530
"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   531
    this class provides the interface to X11. It redefines all required methods
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   532
    from DeviceWorkstation.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   533
    Notice, that in Smalltalk/X you are not technically limited to one display;
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   534
    in theory (and in our practice), you can create Views on many displays
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   535
    simultanously. However, the default setup is for one display only.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   536
    To support multiple displays, you will have to start another event dispatcher
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   537
    process for the other display(s) and create the other views with a slightly
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   538
    different protocol (ApplicationModel openOnDevice:) or by temporarily answering
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   539
    the other device to the currentScreen query.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   540
    Therefore, 'normal' applications do not have to care for all of this, as the currentScreen
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   541
    query is answered by the launcher when opening its applications.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   542
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   543
    Timeouts:
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   544
        sometimes, X-connections are lost and, as the Xlib is blocking and synchronous by
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   545
        default, this would lead to a locked ST/X system.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   546
        Therefore, this class defines a timeOut, whenever doing an Xlib call.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   547
        The default for this timeout is 30seconds.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   548
        This may be a problem with windowmanagers which show a rubber-band rectangle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   549
        when creating windows.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   550
        If the user does not specify the rectangle within 30 seconds, the device assumes
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   551
        a timeout and closes the connection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   552
        As a (kludgy) workaround, a second timeout value is used for window-creation.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   553
        This secondary timeout value defaults to 60*5 seconds (5 minutes).
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   554
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   555
    See more documentation in my superclass, DeviceWorkstation.
613
c12586985dcd documentation
Claus Gittinger <cg@exept.de>
parents: 568
diff changeset
   556
c12586985dcd documentation
Claus Gittinger <cg@exept.de>
parents: 568
diff changeset
   557
    [author:]
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   558
        Claus Gittinger
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   559
"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   560
! !
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   561
1171
a40ea3d796fd newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   562
!XWorkstation class methodsFor:'initialization'!
250
eaa532ebcad7 modifierKeyProcessing now done in DevWorkstat via tables;
Claus Gittinger <cg@exept.de>
parents: 240
diff changeset
   563
eaa532ebcad7 modifierKeyProcessing now done in DevWorkstat via tables;
Claus Gittinger <cg@exept.de>
parents: 240
diff changeset
   564
initialize
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   565
    ConservativeSync := OperatingSystem isMSWINDOWSlike.
2592
43cd99949614 need sync before asking for pending event on WIN32 systems.
Claus Gittinger <cg@exept.de>
parents: 2541
diff changeset
   566
3267
de85f7d8dc5f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3263
diff changeset
   567
    "/ some XServers crash, when given too long strings in XDrawString/XDrawInageString.
de85f7d8dc5f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3263
diff changeset
   568
    "/ the following is an adjustable soft-limit.
de85f7d8dc5f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3263
diff changeset
   569
    MaxStringLength := 4096.
de85f7d8dc5f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3263
diff changeset
   570
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   571
    "/ shutdown the X-connection, when no response is received after that many seconds.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   572
    DefaultXLibTimeout := 30.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   573
    DefaultXLibTimeoutForWindowCreation := 5*60.
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   574
3321
3d0e6754dcd9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3320
diff changeset
   575
    RawKeySymTranslation isNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   576
        "/ the following table maps X-keyevents to ST/X
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   577
        "/ device independend events.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   578
        "/ It is NOT meant as a keyboardMap replacement.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   579
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   580
        RawKeySymTranslation := Dictionary new:6.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   581
        RawKeySymTranslation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   582
            at:#'Delete_line' put:#DeleteLine;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   583
            at:#'Delete_word' put:#DeleteWord;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   584
            at:#Down put:#CursorDown;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   585
            at:#Up put:#CursorUp;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   586
            at:#Left put:#CursorLeft;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   587
            at:#Right put:#CursorRight.
386
f9a80cac659e only init once
Claus Gittinger <cg@exept.de>
parents: 382
diff changeset
   588
    ]
2592
43cd99949614 need sync before asking for pending event on WIN32 systems.
Claus Gittinger <cg@exept.de>
parents: 2541
diff changeset
   589
43cd99949614 need sync before asking for pending event on WIN32 systems.
Claus Gittinger <cg@exept.de>
parents: 2541
diff changeset
   590
    "Modified: / 27.4.1999 / 17:21:30 / cg"
250
eaa532ebcad7 modifierKeyProcessing now done in DevWorkstat via tables;
Claus Gittinger <cg@exept.de>
parents: 240
diff changeset
   591
! !
eaa532ebcad7 modifierKeyProcessing now done in DevWorkstat via tables;
Claus Gittinger <cg@exept.de>
parents: 240
diff changeset
   592
1171
a40ea3d796fd newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   593
!XWorkstation class methodsFor:'error handling'!
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   594
129
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   595
debug:aBoolean
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   596
%{  /* NOCONTEXT */
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   597
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   598
    __debug__ = (aBoolean == true) ? 1 : 0;
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   599
%}
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   600
!
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   601
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   602
debugResources
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   603
%{
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   604
#ifdef COUNT_RESOURCES
4723
ad10f05ff89b printf -> console_printf
Claus Gittinger <cg@exept.de>
parents: 4711
diff changeset
   605
    console_fprintf(stderr, "colors:%d bitmaps:%d views:%d gc:%d cursors:%d fonts:%d\n",
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   606
            __cnt_color, __cnt_bitmap,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   607
            __cnt_view, __cnt_gc, __cnt_cursor, __cnt_font);
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   608
#endif
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   609
%}
1404
680d840cbd3f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1392
diff changeset
   610
680d840cbd3f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1392
diff changeset
   611
    "
680d840cbd3f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1392
diff changeset
   612
     XWorkstation debugResources
680d840cbd3f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1392
diff changeset
   613
    "
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   614
!
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
   615
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   616
errorStringOfLastError
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   617
%{
1065
fdc5b9059d82 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1062
diff changeset
   618
    RETURN ( __MKSTRING(lastErrorMsg) );
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   619
%}
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   620
!
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   621
3036
427225abb47f Catch number decoding error.
Stefan Vogel <sv@exept.de>
parents: 3018
diff changeset
   622
getConnectionTimeOut
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   623
    "returns the default connectionTimeOut (seconds)"
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   624
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   625
    ^ DefaultXLibTimeout
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   626
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   627
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   628
getConnectionTimeOutForWindowCreation
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   629
    "returns the default connectionTimeOut (seconds)"
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   630
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   631
    ^ DefaultXLibTimeoutForWindowCreation
3036
427225abb47f Catch number decoding error.
Stefan Vogel <sv@exept.de>
parents: 3018
diff changeset
   632
!
427225abb47f Catch number decoding error.
Stefan Vogel <sv@exept.de>
parents: 3018
diff changeset
   633
135
claus
parents: 133
diff changeset
   634
lastErrorString
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   635
    "return the last X-error string -
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   636
     when buffering is on, this may be
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   637
     an error for a long-ago operation"
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   638
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   639
    |string s match line requestCode|
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   640
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   641
    string := self errorStringOfLastError.
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   642
    requestCode := self requestCodeOfLastError.
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   643
78
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   644
    "
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   645
     X specific: search the requestCode in '/usr/lib/X11/XErrorDB',
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   646
     and append the name of the corresponding X-request
1c9c22df3251 *** empty log message ***
claus
parents: 73
diff changeset
   647
    "
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   648
    match := 'XRequest.' , requestCode printString.
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   649
    ErrorDBCache isNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   650
        ErrorDBCache := IdentityDictionary new.
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   651
    ].
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   652
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
   653
    "if there is no XErrorDB or no entry, the line for the requestCode is cached as nil"
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   654
    line := ErrorDBCache at:requestCode ifAbsentPut:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   655
            |errorLine|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   656
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   657
            s := '/usr/share/X11/XErrorDB' asFilename readStreamOrNil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   658
            s notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   659
                errorLine := s peekForLineStartingWith:match.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   660
                errorLine notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   661
                    errorLine := errorLine copyFrom:(errorLine indexOf:$:)+1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   662
                ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   663
                s close.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   664
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   665
            errorLine
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   666
        ].
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   667
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   668
    line isNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   669
        line := match
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   670
    ].
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   671
    ^ string , ' in ' , line.
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   672
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   673
    "
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   674
        Screen lastErrorString
6214
14574c9caac6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6177
diff changeset
   675
    "
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   676
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   677
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   678
minorCodeOfLastError
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   679
%{  /* NOCONTEXT */
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   680
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   681
    RETURN ( __MKSMALLINT(lastMinorCode) );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   682
%}
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   683
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   684
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   685
requestCodeOfLastError
152
claus
parents: 150
diff changeset
   686
%{  /* NOCONTEXT */
claus
parents: 150
diff changeset
   687
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   688
    RETURN ( __MKSMALLINT(lastRequestCode) );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   689
%}
135
claus
parents: 133
diff changeset
   690
!
claus
parents: 133
diff changeset
   691
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   692
resourceIdOfLastError
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   693
%{  /* NOCONTEXT */
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   694
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   695
      if (lastResource != 0) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   696
         RETURN ( __MKEXTERNALADDRESS(lastResource) );
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   697
      }
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   698
%}.
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   699
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   700
     ^ nil
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   701
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   702
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   703
     "
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   704
         Screen resourceIdOfLastError
4252
9dca820cd786 Fix selection handling (utf8 / incremental transmission)
Stefan Vogel <sv@exept.de>
parents: 4245
diff changeset
   705
     "
3016
326429127f47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3015
diff changeset
   706
!
326429127f47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3015
diff changeset
   707
326429127f47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3015
diff changeset
   708
setConnectionTimeOut:seconds
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   709
    "set the default connection timeout (seconds)"
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   710
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   711
    DefaultXLibTimeout := seconds
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   712
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   713
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   714
setConnectionTimeOutForWindowCreation:seconds
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   715
    "set the default connection timeout (seconds)"
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   716
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   717
    DefaultXLibTimeoutForWindowCreation := seconds
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   718
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   719
1171
a40ea3d796fd newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   720
!XWorkstation class methodsFor:'queries'!
104
aa39cabdc13b *** empty log message ***
claus
parents: 98
diff changeset
   721
6573
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
   722
isX11Platform
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
   723
    ^ true
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
   724
!
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
   725
104
aa39cabdc13b *** empty log message ***
claus
parents: 98
diff changeset
   726
platformName
133
claus
parents: 132
diff changeset
   727
    "ST-80 compatibility.
2777
60ba83db1fab comment
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   728
     Return a string describing the display systems platform.
5036
62bd216d3daf #platfromName - use symbol
Stefan Vogel <sv@exept.de>
parents: 5034
diff changeset
   729
     XWorkstation always returns #X11."
62bd216d3daf #platfromName - use symbol
Stefan Vogel <sv@exept.de>
parents: 5034
diff changeset
   730
62bd216d3daf #platfromName - use symbol
Stefan Vogel <sv@exept.de>
parents: 5034
diff changeset
   731
    ^ #X11  "I don't know what ST-80 returns for X ..."
715
0c715cbd2bde checkin from browser
Claus Gittinger <cg@exept.de>
parents: 697
diff changeset
   732
0c715cbd2bde checkin from browser
Claus Gittinger <cg@exept.de>
parents: 697
diff changeset
   733
    "Modified: 26.5.1996 / 15:32:46 / cg"
104
aa39cabdc13b *** empty log message ***
claus
parents: 98
diff changeset
   734
! !
aa39cabdc13b *** empty log message ***
claus
parents: 98
diff changeset
   735
1583
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
   736
!XWorkstation methodsFor:'Signal constants'!
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
   737
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   738
deviceIOTimeoutErrorSignal
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   739
    "return the per-device signal, which is raised when a timeout
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   740
     IO error (i.e. broken connection) occurs."
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   741
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
   742
    ^ deviceIOTimeoutErrorSignal
1583
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
   743
! !
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
   744
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   745
!XWorkstation methodsFor:'accessing'!
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   746
6177
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   747
displayId
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   748
    ^ displayId
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   749
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   750
    "Created: / 20-12-2013 / 11:02:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   751
!
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   752
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   753
displayIdOrErrorIfBroken
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   754
    (hasConnectionBroken or:[displayId isNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   755
	self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   756
	^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   757
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   758
    ^ displayId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   759
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   760
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   761
displayIdOrNilIfBroken
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   762
    hasConnectionBroken ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   763
	^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   764
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   765
    ^ displayId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   766
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   767
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   768
maxOperationsUntilFlush
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   769
    ^ maxOperationsUntilFlush
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   770
!
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   771
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   772
maxOperationsUntilFlush:anIntegerOrNil
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   773
    "if not nil, after anInteger number of draw operations
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   774
     a flush is performed.
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   775
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   776
     This is to work around a drawing problem which occurs on
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   777
     Ubuntu 12.04 64bit running on a VMware player (2013-11)."
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   778
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
   779
    maxOperationsUntilFlush := anIntegerOrNil.
6177
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   780
!
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   781
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   782
screen
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   783
    ^ screen
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   784
53a2b3f77dd3 class: XWorkstation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 6172
diff changeset
   785
    "Created: / 20-12-2013 / 11:02:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   786
! !
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
   787
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   788
!XWorkstation methodsFor:'accessing & queries'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   789
2685
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   790
activateOnClick:aBoolean
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   791
    "set/clear the activateOnClick behavior.
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   792
     If on, a click into a window raises and activates
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   793
     the (top) window.
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   794
     Windows users typically enable this;
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   795
     in contrast, those used to the X-Window system typically prefer
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   796
     it disabled.
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   797
     Returns the previous setting."
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   798
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   799
    |prev|
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   800
3245
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   801
    prev := activateOnClick ? false.
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   802
    aBoolean notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   803
        activateOnClick := aBoolean.
3245
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   804
    ].
2685
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   805
    ^ prev
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   806
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   807
    "
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   808
     Display class activateOnClick:true
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   809
     Display class activateOnClick:false
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   810
    "
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   811
!
094ce08f9fc5 made activateOnClick an instance method
Claus Gittinger <cg@exept.de>
parents: 2671
diff changeset
   812
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   813
anyButtonMotionMask
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   814
    "return the state-mask for any button in motion events' state-field.
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   815
     This is the devices mask."
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   816
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   817
%{  /* NOCONTEXT */
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   818
    RETURN (__MKSMALLINT(Button1MotionMask | Button2MotionMask | Button3MotionMask));
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   819
%}.
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   820
    ^ nil
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   821
!
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   822
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   823
blackpixel
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   824
    "return the colornumber of black"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   825
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   826
    ^ blackpixel
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   827
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   828
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   829
button1MotionMask
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   830
    "return the state-mask for button1 in motion events' state-field.
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   831
     For backward compatibility."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   832
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   833
%{  /* NOCONTEXT */
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   834
    RETURN (__MKSMALLINT(Button1MotionMask));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   835
%}
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   836
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   837
    "
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   838
     Display button1MotionMask
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   839
    "
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   840
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   841
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   842
button2MotionMask
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   843
    "return the state-mask for button2 in motion events' state-field
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   844
     For backward compatibility."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   845
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   846
%{  /* NOCONTEXT */
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   847
    RETURN (__MKSMALLINT(Button2MotionMask));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   848
%}
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   849
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   850
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   851
button3MotionMask
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   852
    "return the state-mask for button3 in motion events' state-field
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   853
     For backward compatibility."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   854
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   855
%{  /* NOCONTEXT */
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   856
    RETURN (__MKSMALLINT(Button3MotionMask));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   857
%}
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   858
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   859
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   860
buttonMotionMask:aButton
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   861
    "return the state-mask for button1 in motion events state-field.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   862
     This is the devices mask."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   863
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   864
%{  /* NOCONTEXT */
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   865
    if (aButton == __MKSMALLINT(1)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   866
        RETURN (__MKSMALLINT(Button1MotionMask));
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   867
    }
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   868
    if (aButton == __MKSMALLINT(2)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   869
        RETURN (__MKSMALLINT(Button2MotionMask));
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   870
    }
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
   871
    if (aButton == __MKSMALLINT(3)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   872
        RETURN (__MKSMALLINT(Button3MotionMask));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   873
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   874
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   875
    ^ nil
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   876
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
   877
382
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   878
controlMask
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   879
    "return the state-mask for the CTRL modified in motion events' state-field."
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   880
3245
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   881
    "/ obsolete
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   882
    ^ self ctrlModifierMask
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   883
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   884
382
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   885
!
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   886
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   887
displayFileDescriptor
48194c26a46c Initial revision
claus
parents:
diff changeset
   888
    "return the displays fileNumber - for select"
48194c26a46c Initial revision
claus
parents:
diff changeset
   889
48194c26a46c Initial revision
claus
parents:
diff changeset
   890
%{  /* NOCONTEXT */
2231
817b5fad2fb7 md changes for WIN32
Claus Gittinger <cg@exept.de>
parents: 2195
diff changeset
   891
#ifndef WIN32
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   892
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   893
        RETURN ( __MKSMALLINT(ConnectionNumber(myDpy)) );
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   894
    }
2231
817b5fad2fb7 md changes for WIN32
Claus Gittinger <cg@exept.de>
parents: 2195
diff changeset
   895
#endif
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
   896
    RETURN (nil);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   897
%}
48194c26a46c Initial revision
claus
parents:
diff changeset
   898
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   899
133
claus
parents: 132
diff changeset
   900
displayName
claus
parents: 132
diff changeset
   901
    "return the X-connections display name.
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
   902
     This is (currently) nil for the default display,
133
claus
parents: 132
diff changeset
   903
     something like foo:0 for any other remote display.
claus
parents: 132
diff changeset
   904
     Future versions may return non-nil strings for the default display as well."
claus
parents: 132
diff changeset
   905
claus
parents: 132
diff changeset
   906
    ^ displayName
claus
parents: 132
diff changeset
   907
!
claus
parents: 132
diff changeset
   908
4153
a6d682af620b *** empty log message ***
werner
parents: 4127
diff changeset
   909
displayName: something
a6d682af620b *** empty log message ***
werner
parents: 4127
diff changeset
   910
a6d682af620b *** empty log message ***
werner
parents: 4127
diff changeset
   911
    displayName := something
a6d682af620b *** empty log message ***
werner
parents: 4127
diff changeset
   912
!
a6d682af620b *** empty log message ***
werner
parents: 4127
diff changeset
   913
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   914
protocolVersion
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   915
    "return the X-servers protocol version - should normally not be of
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   916
     any interest"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   917
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   918
%{  /* NOCONTEXT */
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   919
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   920
        RETURN ( __MKSMALLINT(XProtocolVersion(myDpy)) );
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   921
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   922
    RETURN (nil);
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   923
%}
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   924
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   925
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   926
     Display protocolVersion
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   927
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   928
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   929
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   930
serverVendor
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   931
    "return the X-server vendor string - this should normally not be of
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   932
     any interest, but can be for special cases
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   933
     (to avoid bugs in certain implementations)"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   934
%{
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   935
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   936
        RETURN ( __MKSTRING(XServerVendor(myDpy)) );
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   937
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   938
    RETURN (nil);
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   939
%}
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   940
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   941
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   942
     Display serverVendor
5993
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
   943
     Display platformName
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   944
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   945
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   946
382
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   947
shiftMask
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   948
    "return the state-mask for the SHIFT modified in motion events' state-field."
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
   949
3245
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   950
    "/ obsolete
b548dcf4993f cleanup
Claus Gittinger <cg@exept.de>
parents: 3238
diff changeset
   951
    ^ self shiftModifierMask
382
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   952
!
92200ee9f558 added sendKey/sendButtonEvent
ah
parents: 378
diff changeset
   953
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   954
translatePoint:aPoint from:windowId1 to:windowId2
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   955
    "given a point in window1, return the coordinate in window2.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   956
     This expects a device coordinate (relative to the first views origin)
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   957
     in aPoint and returns a device coordinate relative to the 2nd views origin.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   958
     - use to xlate points from a window to rootwindow"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   959
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
   960
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
   961
5862
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
   962
    |x1 y1 x2 y2 rootWindowId|
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   963
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   964
    x1 := x2 := aPoint x truncated.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   965
    y1 := y2 := aPoint y truncated.
5862
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
   966
    rootWindowId := self rootWindowId.
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
   967
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   968
%{
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   969
    int xpos, ypos;
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
   970
    Window w1, w2, child_ret;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
   971
    int screen = __intVal(__INST(screen));
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   972
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   973
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
   974
     && __isExternalAddress(windowId1)
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   975
     && __isExternalAddress(windowId2)
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   976
     && __bothSmallInteger(x1, y1)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   977
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   978
        Window rootWin;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   979
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   980
        w1 = __WindowVal(windowId1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   981
        w2 = __WindowVal(windowId2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   982
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   983
        rootWin = RootWindow(dpy, screen);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   984
        if (w1 == rootWin) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   985
            w1 = (Window)__externalAddressVal(rootWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   986
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   987
        if (w2 == rootWin) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   988
            w2 = (Window)__externalAddressVal(rootWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   989
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   990
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   991
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   992
        XTranslateCoordinates(dpy, w1, w2,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   993
                              __intVal(x1), __intVal(y1),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   994
                              &xpos, &ypos, &child_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   995
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   996
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   997
        x2 = __MKSMALLINT(xpos);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
   998
        y2 = __MKSMALLINT(ypos);
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
   999
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1000
%}.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1001
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1002
    ^ (x2 @ y2)
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1003
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1004
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1005
vendorRelease
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1006
    "return the X-servers vendor release - should normally not be of
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1007
     any interest, but can be for special cases.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1008
     (to avoid bugs in certain implementations)"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1009
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1010
%{  /* NOCONTEXT */
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1011
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1012
        RETURN ( __MKSMALLINT(XVendorRelease(myDpy)) );
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1013
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1014
    RETURN (nil);
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1015
%}
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1016
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1017
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1018
     Display vendorRelease
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1019
    "
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1020
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1021
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1022
viewIdFromPoint:aPoint in:windowId
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1023
    "given a point in rootWindow, return the viewId of the subview of windowId
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1024
     hit by this coordinate. Return nil if no view was hit.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1025
     The returned id may be the id of a non ST view.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1026
     - used to find the window to drop objects after a cross-view drag."
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1027
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1028
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1029
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1030
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1031
    int screen = __intVal(__INST(screen));
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1032
    OBJ xp, yp;
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1033
    int xpos, ypos;
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
  1034
    Window child_ret;
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1035
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  1036
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  1037
     && __isExternalAddress(windowId)
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1038
     && __isPoint(aPoint)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1039
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1040
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1041
        xp = _point_X(aPoint);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1042
        yp = _point_Y(aPoint);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1043
        if (__bothSmallInteger(xp, yp)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1044
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1045
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1046
            XTranslateCoordinates(dpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1047
                                  RootWindow(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1048
                                  __WindowVal(windowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1049
                                  __intVal(xp), __intVal(yp),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1050
                                  &xpos, &ypos, &child_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1051
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1052
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1053
            if (child_ret) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1054
                RETURN ( __MKEXTERNALADDRESS(child_ret) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1055
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1056
            RETURN ( nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1057
        }
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1058
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1059
%}.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1060
    windowId notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1061
        aPoint isPoint ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1062
            ^ self viewIdFromPoint:aPoint asPoint truncated in:windowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1063
        ]
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1064
    ].
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1065
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1066
    ^ nil
3412
91fe6c42822d Fix for KDE 2.1 windowmanager (virtual root view)
Stefan Vogel <sv@exept.de>
parents: 3333
diff changeset
  1067
91fe6c42822d Fix for KDE 2.1 windowmanager (virtual root view)
Stefan Vogel <sv@exept.de>
parents: 3333
diff changeset
  1068
    "
91fe6c42822d Fix for KDE 2.1 windowmanager (virtual root view)
Stefan Vogel <sv@exept.de>
parents: 3333
diff changeset
  1069
      Display viewIdFromPoint:100@100 in:Display realRootWindowId
91fe6c42822d Fix for KDE 2.1 windowmanager (virtual root view)
Stefan Vogel <sv@exept.de>
parents: 3333
diff changeset
  1070
    "
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1071
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1072
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1073
virtualExtent
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1074
    "return the virtual extent of the display (in pixels).
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1075
     On most systems, this is the same as the physical width;
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1076
     except, if a window manager with a virtual desktop like olvwm
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1077
     (simulating a bigger screen) is running."
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1078
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1079
%{
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  1080
    if (ISCONNECTED
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1081
     && (__INST(rootId) != __INST(virtualRootId))
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1082
     && __isExternalAddress(__INST(virtualRootId))) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1083
        Window vRootWin;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1084
        Window root;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1085
        int x, y;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1086
        unsigned int width, height;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1087
        unsigned int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1088
        int ret;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1089
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1090
        vRootWin = __WindowVal(__INST(virtualRootId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1091
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1092
        ret = XGetGeometry(myDpy, vRootWin, &root, &x, &y, &width, &height,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1093
                                          &dummy, &dummy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1094
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1095
        if (ret) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1096
            RETURN ( __MKPOINT_INT(width, height) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1097
        }
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1098
    }
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1099
%}.
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1100
    ^ width @ height
5862
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
  1101
   "
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
  1102
     Display virtualExtent
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
  1103
     Display extent
8270a6c0c613 Virtual root handling for multiple screens
Stefan Vogel <sv@exept.de>
parents: 5850
diff changeset
  1104
   "
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1105
!
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1106
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1107
whitepixel
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1108
    "return the colornumber of white"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1109
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1110
    ^ whitepixel
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1111
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1112
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1113
xlibTimeout
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1114
    ^ xlibTimeout
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1115
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1116
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1117
xlibTimeout:seconds
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1118
    xlibTimeout := seconds
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1119
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1120
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1121
xlibTimeoutForWindowCreation
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1122
    ^ xlibTimeoutForWindowCreation
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1123
!
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1124
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1125
xlibTimeoutForWindowCreation:seconds
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1126
    xlibTimeoutForWindowCreation := seconds
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1127
! !
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1128
3263
bd92a12c9316 category changes
Claus Gittinger <cg@exept.de>
parents: 3250
diff changeset
  1129
!XWorkstation methodsFor:'accessing-display capabilities'!
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1130
5993
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1131
extentOfResizeHandle
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1132
    "if the window system needs any area for a window resize handle (such as on MACOS-X),
5998
04c91c9d90f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5993
diff changeset
  1133
     this area's extent is returned here. It is assumed, that this handle is located at the lower-right
5993
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1134
     of the window.
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1135
     0@0 is returned for systems which locate the resize handles outside the client area.
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1136
     This may be used by the UI painter or programmatically to reserve some client area.
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1137
     This method must be redefined for displays which need it (i.e. X11 on osx)"
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1138
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1139
    OperatingSystem getOSType == #osx ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1140
        "/ should check for local display here - sigh, osx's Xserver does not give
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1141
        "/ us a hint through the server vendor...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1142
        ^ 16@16
5993
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1143
    ].
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1144
    ^ 0@0
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1145
!
979e2a2f250b class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 5989
diff changeset
  1146
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1147
hasDPS
186
claus
parents: 180
diff changeset
  1148
    "return true, if this workstation supports display postscript.
claus
parents: 180
diff changeset
  1149
     Both the server must support it, and the feature must have been
claus
parents: 180
diff changeset
  1150
     enabled in the smalltalk system, for true to be returned."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1151
48194c26a46c Initial revision
claus
parents:
diff changeset
  1152
    ^ hasDPSExtension
186
claus
parents: 180
diff changeset
  1153
claus
parents: 180
diff changeset
  1154
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1155
     Display hasDPS
186
claus
parents: 180
diff changeset
  1156
    "
claus
parents: 180
diff changeset
  1157
!
claus
parents: 180
diff changeset
  1158
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1159
hasExtension:extensionString
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1160
    "query for an X extension. The argument, extensionString
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1161
     should be the name of the extension (i.e. 'SHAPE', 'XInputExtension' etc).
186
claus
parents: 180
diff changeset
  1162
     Return true, if that extension is available in the server.
claus
parents: 180
diff changeset
  1163
     (which does not imply, that there is support in smalltalk for it."
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1164
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1165
    <context: #return>
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1166
%{
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1167
    int dummy;
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1168
    OBJ rslt = false;
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1169
2531
e4d6bdae7bcf use quick-isString / isSymbol
Claus Gittinger <cg@exept.de>
parents: 2501
diff changeset
  1170
    if (ISCONNECTED
5467
0685d08ef9b4 isStringLike / isArrayLike
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1171
     && __isStringLike(extensionString)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1172
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1173
        if (XQueryExtension(myDpy, __stringVal(extensionString), &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1174
            rslt = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1175
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1176
        LEAVE_XLIB();
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1177
    }
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1178
    RETURN (rslt);
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1179
%}
186
claus
parents: 180
diff changeset
  1180
claus
parents: 180
diff changeset
  1181
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1182
     Display hasExtension:'XVideo'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1183
     Display hasExtension:'Input'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1184
     Display hasExtension:'GLX'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1185
     Display hasExtension:'X3D-PEX'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1186
     Display hasExtension:'XInputExtension'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1187
     Display hasExtension:'SHAPE'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1188
     Display hasExtension:'MIT-SHM'
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1189
     Display hasExtension:'SGIFullScreenStereo'
186
claus
parents: 180
diff changeset
  1190
    "
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1191
!
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1192
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1193
hasImageExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1194
    "return true, if this workstation supports the X image extension.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1195
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1196
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1197
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1198
    ^ hasImageExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1199
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1200
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1201
     Display hasImageExtension
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1202
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1203
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1204
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1205
hasInputExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1206
    "return true, if this workstation supports the X input extension.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1207
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1208
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1209
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1210
    ^ hasInputExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1211
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1212
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1213
     Display hasInputExtension
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1214
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1215
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1216
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1217
hasMultibuffer
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1218
    "return true, if this workstation supports the multibuffer extension.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1219
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1220
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1221
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1222
    ^ hasMbufExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1223
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1224
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1225
     Display hasMultibuffer
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1226
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1227
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1228
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1229
hasPEX
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1230
    "return true, if this workstation supports PEX 3D graphics.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1231
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1232
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1233
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1234
    ^ hasPEXExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1235
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1236
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1237
     Display hasPEX
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1238
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1239
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1240
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1241
hasShm
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1242
    "return true, if this workstation supports the shared pixmap extension.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1243
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1244
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1245
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1246
    ^ hasShmExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1247
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1248
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1249
     Display hasShm
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1250
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1251
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1252
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1253
hasXVideo
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1254
    "return true, if this workstation supports the XVideo extension.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1255
     Both the server must support it, and the feature must have been
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1256
     enabled in the smalltalk system, for true to be returned."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1257
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1258
    ^ hasXVideoExtension
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1259
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1260
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1261
     Display hasXVideo
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1262
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1263
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1264
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1265
iconSizes
540
c954c490c8be stateMask methods & commentary
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
  1266
    "Get the preferred/supported icon sizes. These are set by the window manager.
819
88aaa6ff1ca3 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 818
diff changeset
  1267
     We return nil (if not set) or an OrderedCollection of iconSize specs."
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1268
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1269
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1270
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1271
    |xIconSizes count ret|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1272
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1273
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1274
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1275
    XIconSize *sizeList;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1276
    int cnt;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1277
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1278
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1279
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1280
        int status;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1281
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1282
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1283
        status = XGetIconSizes(dpy, RootWindow(dpy, screen), &sizeList, &cnt);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1284
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1285
        if (status > 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1286
           xIconSizes = __MKEXTERNALBYTES(sizeList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1287
           count = __MKSMALLINT(cnt);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1288
        }
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1289
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1290
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1291
    xIconSizes isNil ifTrue:[^ nil].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1292
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1293
    ret := OrderedCollection new:count.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1294
    1 to:count do:[ :i |
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1295
        |minWidth minHeight maxWidth maxHeight widthStep heightStep d|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1296
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1297
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1298
        XIconSize *slp;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1299
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1300
        slp = &((XIconSize *)__externalAddressVal(xIconSizes))[__intVal(i)-1];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1301
        minWidth = __MKSMALLINT(slp->min_width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1302
        minHeight = __MKSMALLINT(slp->min_height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1303
        maxWidth = __MKSMALLINT(slp->max_width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1304
        maxHeight = __MKSMALLINT(slp->max_height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1305
        widthStep = __MKSMALLINT(slp->width_inc);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1306
        heightStep = __MKSMALLINT(slp->height_inc);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1307
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1308
        d := IdentityDictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1309
        d at:#minWidth put:minWidth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1310
        d at:#maxWidth put:maxWidth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1311
        d at:#widthStep put:widthStep.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1312
        d at:#minHeight put:minHeight.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1313
        d at:#maxHeight put:maxHeight.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1314
        d at:#heightStep put:heightStep.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1315
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1316
        ret add:d
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1317
    ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1318
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1319
    xIconSizes free.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1320
    ^ ret
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1321
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1322
    "
819
88aaa6ff1ca3 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 818
diff changeset
  1323
     Display iconSizes
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1324
    "
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1325
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1326
341
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1327
ignoreBackingStore:aBoolean
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1328
    "if the argument is true, the views backingStore setting will be ignored, and
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1329
     no backing store used - this can be used on servers where backing store is
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1330
     very slow or is broken (can be put into display-rc-file)"
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1331
47ac178c3924 modifiermappings - again
Claus Gittinger <cg@exept.de>
parents: 334
diff changeset
  1332
    ignoreBackingStore := aBoolean
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1333
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1334
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1335
monitorBounds
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1336
    "ask the X server via the Xinerama extension about the available minitors.
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1337
     The first monitor returned is the primary monitor"
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1338
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1339
    |numberOfMonitors resultArray bounds|
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1340
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1341
%{
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1342
#ifdef XINERAMA
5885
a5af5e4ee7c8 changed:
Stefan Vogel <sv@exept.de>
parents: 5872
diff changeset
  1343
    if (ISCONNECTED && __INST(hasXineramaExtension) == true) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1344
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1345
        XineramaScreenInfo *screenInfo;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1346
        int numDisplays;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1347
        OBJ *cResultArray;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1348
        int i, ci;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1349
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1350
        screenInfo = XineramaQueryScreens (dpy, &numDisplays);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1351
        if (screenInfo == 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1352
            goto out;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1353
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1354
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1355
        numberOfMonitors = __mkSmallInteger(numDisplays);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1356
        resultArray = __ARRAY_NEW_INT(numDisplays * 5);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1357
        cResultArray = __ArrayInstPtr(resultArray)->a_element;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1358
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1359
        for (i=0, ci=0; i < numDisplays; i++, ci+=5) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1360
            cResultArray[ci] = __mkSmallInteger(screenInfo[i].screen_number);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1361
            cResultArray[ci+1] = __mkSmallInteger(screenInfo[i].x_org);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1362
            cResultArray[ci+2] = __mkSmallInteger(screenInfo[i].y_org);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1363
            cResultArray[ci+3] = __mkSmallInteger(screenInfo[i].width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1364
            cResultArray[ci+4] = __mkSmallInteger(screenInfo[i].height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1365
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1366
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1367
        XFree(screenInfo);
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1368
    }
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1369
#endif
5885
a5af5e4ee7c8 changed:
Stefan Vogel <sv@exept.de>
parents: 5872
diff changeset
  1370
out:;
a5af5e4ee7c8 changed:
Stefan Vogel <sv@exept.de>
parents: 5872
diff changeset
  1371
%}.
a5af5e4ee7c8 changed:
Stefan Vogel <sv@exept.de>
parents: 5872
diff changeset
  1372
    numberOfMonitors isNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1373
        "no xinerama - the display is the only monitor"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1374
        ^ Array with:self bounds.
5885
a5af5e4ee7c8 changed:
Stefan Vogel <sv@exept.de>
parents: 5872
diff changeset
  1375
    ].
5891
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1376
    rawMonitorBounds = resultArray ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1377
        ^ monitorBounds.
5891
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1378
    ].
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1379
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1380
    bounds := Array new:numberOfMonitors.
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1381
    1 to:numberOfMonitors do:[:idx|
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1382
        |rect baseIdx|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1383
        baseIdx := (idx-1) * 5.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1384
        rect := Rectangle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1385
                    left:(resultArray at:baseIdx+2)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1386
                    top:(resultArray at:baseIdx+3)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1387
                    width:(resultArray at:baseIdx+4)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1388
                    height:(resultArray at:baseIdx+5).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1389
        bounds at:idx put:rect.
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1390
    ].
5891
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1391
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1392
    rawMonitorBounds := resultArray.
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1393
    monitorBounds := bounds.
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1394
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1395
    "since the monitor configuration changed,
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1396
     we have to update the monitor settings"
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1397
5892
491bf533899e added: #initializeScreenBounds
Stefan Vogel <sv@exept.de>
parents: 5891
diff changeset
  1398
    self initializeScreenBounds.
5891
a8f6f8d746ef changed: #monitorBounds
Stefan Vogel <sv@exept.de>
parents: 5890
diff changeset
  1399
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1400
    ^ bounds
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1401
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1402
    "
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1403
     Display monitorBounds
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1404
    "
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1405
!
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1406
5870
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1407
monitorBoundsAt:aPoint
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1408
    |bounds|
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1409
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1410
    bounds := self monitorBounds.
5998
04c91c9d90f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5993
diff changeset
  1411
    ^ bounds
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1412
        detect:[:eachRectangle| eachRectangle containsPoint:aPoint]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1413
        ifNone:[super monitorBoundsAt:aPoint].
5870
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1414
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1415
    "
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1416
     Screen current monitorBoundsAt:(0@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1417
     Screen current monitorBoundsAt:(1500@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1418
     Screen current monitorBoundsAt:(3000@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1419
     Screen current monitorBoundsAt:(9000@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1420
     Screen current monitorBoundsAt:(Display pointFromUser)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1421
    "
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1422
!
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1423
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1424
numberOfMonitors
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1425
    ^ self monitorBounds size
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1426
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1427
    "
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1428
        Display numberOfMonitors
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1429
    "
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1430
!
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1431
5870
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1432
pointIsVisible:aPoint
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1433
    "is the point visible?"
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1434
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1435
    |bounds|
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1436
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1437
    bounds := self monitorBounds.
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1438
    ^ bounds contains:[:eachRectangle| eachRectangle containsPoint:aPoint].
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1439
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1440
    "
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1441
     Screen current pointIsVisible:(0@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1442
     Screen current pointIsVisible:(1500@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1443
     Screen current pointIsVisible:(9000@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1444
     Screen current pointIsVisible:(Display pointFromUser)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1445
    "
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1446
!
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1447
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1448
pointsAreOnSameMonitor:point1 and:point2
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1449
    "are the two points on the same (multi-screen) monitors?"
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1450
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1451
    ^ (self monitorBoundsAt:point1) = (self monitorBoundsAt:point2)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1452
!
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1453
823
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1454
preferredIconSize
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1455
    "return the displays preferred size for icons.
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1456
     Redefined to return a special value on SGI servers."
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1457
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1458
    self serverVendor = 'Silicon Graphics' ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1459
        ^ 86@68
823
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1460
    ].
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1461
    ^ super preferredIconSize
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1462
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1463
    "Created: 10.6.1996 / 21:06:48 / cg"
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1464
!
1a0933c804ba checkin from browser
Claus Gittinger <cg@exept.de>
parents: 819
diff changeset
  1465
1025
40dde7d8f538 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1018
diff changeset
  1466
scrollsAsynchronous
1008
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1467
    "return true, if this display asynchronously sends expose events after a
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1468
     scroll operation. False otherwise. Asynchronous expose events are an X
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1469
     speciality, which affects a few methods outside of the display class (sorry)"
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1470
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1471
    ^ true
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1472
!
ca0a38a11bdc support (prepared) for devices which do not send asynchronous exposes
Claus Gittinger <cg@exept.de>
parents: 995
diff changeset
  1473
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1474
smallestMonitorHeight
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1475
    "returns the usable height of the smallest monitor in a mult-monito setup"
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1476
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1477
    |minH|
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1478
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1479
    minH := self usableHeight.
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1480
    self monitorBounds do:[:eachBounds |
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1481
        minH := minH min: eachBounds height.
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1482
    ].
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1483
    ^ minH
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1484
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1485
    "
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1486
        Display smallestMonitorHeight
5869
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1487
    "
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1488
!
93ccf272ad13 added:6 methods
Stefan Vogel <sv@exept.de>
parents: 5865
diff changeset
  1489
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1490
supportedImageFormats
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1491
    "return an array with supported image formats;
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1492
     each array entry is an attribute dictionary, consisting of
235
579f3f804a46 padding info in supportedFormats
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
  1493
     depth, bitsPerPixel and padding values."
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1494
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1495
    |nFormats "{ Class: SmallInteger }"
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1496
     formatArray|
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1497
%{
1207
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  1498
    Display *dpy;
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1499
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1500
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1501
        RETURN (nil);
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1502
    }
1207
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  1503
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  1504
    dpy = myDpy;
1898
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
  1505
#ifdef NO_PRIVATE_DISPLAY_ACCESS
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
  1506
    nFormats = __MKSMALLINT(1);
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
  1507
#else
315
2abc494f0c45 _-macros replaced by __-macros
Claus Gittinger <cg@exept.de>
parents: 310
diff changeset
  1508
    nFormats = __MKSMALLINT(DISPLAYACCESS(dpy)->nformats);
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
  1509
#endif
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1510
%}.
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1511
    formatArray := Array new:nFormats.
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1512
    1 to:nFormats do:[:index |
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1513
        |info bitsPerPixelInfo depthInfo paddingInfo i|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1514
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1515
        i := index.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1516
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1517
        ScreenFormat *format;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1518
        Display *dpy = myDpy;
1344
f19217b30901 oops - corrupted
Claus Gittinger <cg@exept.de>
parents: 1341
diff changeset
  1519
1898
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
  1520
#ifdef NO_PRIVATE_DISPLAY_ACCESS
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1521
        depthInfo = __MKSMALLINT(1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1522
        bitsPerPixelInfo = __MKSMALLINT(1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1523
        paddingInfo = __MKSMALLINT(8);
1891
0dc56210cbfb VMS stuff
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
  1524
#else
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1525
        format = DISPLAYACCESS(dpy)->pixmap_format;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1526
        format += (__intVal(i)-1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1527
        bitsPerPixelInfo = __MKSMALLINT(format->bits_per_pixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1528
        depthInfo = __MKSMALLINT(format->depth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1529
        paddingInfo = __MKSMALLINT(format->scanline_pad);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1530
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1531
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1532
        info := IdentityDictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1533
        info at:#depth put:depthInfo.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1534
        info at:#bitsPerPixel put:bitsPerPixelInfo.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1535
        info at:#padding put:paddingInfo.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1536
        formatArray at:index put:info.
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1537
    ].
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1538
    ^ formatArray
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1539
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1540
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1541
     Display supportedImageFormats
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1542
    "
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1543
!
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1544
2635
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1545
supportsAnyViewBackgroundPixmaps
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1546
    "return true, if the device allows pixmaps as
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1547
     viewBackground."
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1548
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1549
    ^ true
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1550
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1551
    "Created: / 4.5.1999 / 18:41:07 / cg"
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1552
!
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1553
2745
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1554
supportsArbitraryShapedViews
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1555
    "return true, if this workstation supports arbitrary shaped windows.
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1556
     Both the server must support it (the shape-extension),
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1557
     and the feature must have been enabled in the smalltalk system,
2745
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1558
     for true to be returned."
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1559
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1560
    ^ hasShapeExtension
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1561
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1562
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1563
     Display supportsArbitraryShapedViews
2745
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1564
    "
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1565
!
55edb7d63d29 #hasShape -> #supportsArbitraryShapedViews
Claus Gittinger <cg@exept.de>
parents: 2713
diff changeset
  1566
2385
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1567
supportsIconViews
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1568
    "return true, if this device supports views as icons.
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1569
     Only Xservers (currently) support this."
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1570
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1571
    ^ true
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1572
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1573
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1574
     Display supportsIconViews
2385
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1575
    "
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1576
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1577
    "Modified: 10.6.1996 / 20:11:48 / cg"
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1578
    "Created: 10.6.1996 / 21:08:18 / cg"
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1579
!
0237421f277c support activateOnClick.
Claus Gittinger <cg@exept.de>
parents: 2361
diff changeset
  1580
2632
e18b55db3e1e replaced supportdMaskedDrawing by a method which gets the
Claus Gittinger <cg@exept.de>
parents: 2594
diff changeset
  1581
supportsMaskedDrawingWith:aForm
e18b55db3e1e replaced supportdMaskedDrawing by a method which gets the
Claus Gittinger <cg@exept.de>
parents: 2594
diff changeset
  1582
    "return true, if the device allows the given form pixmap
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1583
     to be used as paint color.
2632
e18b55db3e1e replaced supportdMaskedDrawing by a method which gets the
Claus Gittinger <cg@exept.de>
parents: 2594
diff changeset
  1584
     True returned here - X has no trouble with any mask."
2330
2de54ce1d8c6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2305
diff changeset
  1585
2de54ce1d8c6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2305
diff changeset
  1586
    ^ true
2632
e18b55db3e1e replaced supportdMaskedDrawing by a method which gets the
Claus Gittinger <cg@exept.de>
parents: 2594
diff changeset
  1587
e18b55db3e1e replaced supportdMaskedDrawing by a method which gets the
Claus Gittinger <cg@exept.de>
parents: 2594
diff changeset
  1588
    "Created: / 4.5.1999 / 12:16:43 / cg"
2330
2de54ce1d8c6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2305
diff changeset
  1589
!
2de54ce1d8c6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2305
diff changeset
  1590
2635
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1591
supportsViewBackgroundPixmap:aForm
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1592
    "return true, if the device allows the given pixmap as
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1593
     viewBackground.
2635
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1594
     True returned here - X support any size."
2305
7746d6252645 added supportsBackgroundPixmaps query (for win32 compatibility)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
  1595
7746d6252645 added supportsBackgroundPixmaps query (for win32 compatibility)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
  1596
    ^ true
2635
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1597
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1598
    "Created: / 4.5.1999 / 18:40:42 / cg"
92ac1edfb047 another view-bg query
Claus Gittinger <cg@exept.de>
parents: 2632
diff changeset
  1599
    "Modified: / 4.5.1999 / 18:44:25 / cg"
2305
7746d6252645 added supportsBackgroundPixmaps query (for win32 compatibility)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
  1600
!
7746d6252645 added supportsBackgroundPixmaps query (for win32 compatibility)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
  1601
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1602
supportsViewGravity
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1603
    "return true, if this device supports gravity attributes.
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1604
     We do not depend on it being implemented, but some resizing operations
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1605
     are faster, it is is."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1606
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1607
    ^ true
5870
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1608
!
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1609
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1610
usableHeightAt:aPoint
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1611
    "returns the usable height of the display (in pixels) at a given point
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1612
     Normally, the same as height, but may be smaller, in
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1613
     case some menu space is taken up by the window manager (windows).
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1614
     On multi-display systems with different sized screens, this should care for
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1615
     which display is at the given x-position"
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1616
6026
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1617
    |h|
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1618
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1619
    h := (self monitorBoundsAt:aPoint) height.
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1620
    OperatingSystem isOSXlike ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1621
        "/ take away some space for the icon-panel at the bottom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1622
        ^ h - 50
6026
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1623
    ].
688f086bfe9e class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6010
diff changeset
  1624
    ^ h
5870
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1625
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1626
    "
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1627
     Screen current usableHeightAt:(0@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1628
     Screen current usableHeightAt:(1500@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1629
     Screen current usableHeightAt:(3000@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1630
     Screen current usableHeightAt:(9000@0)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1631
     Screen current usableHeightAt:(Display pointFromUser)
3c43dc838aaa added:5 methods
Stefan Vogel <sv@exept.de>
parents: 5869
diff changeset
  1632
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1633
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1634
48194c26a46c Initial revision
claus
parents:
diff changeset
  1635
!XWorkstation methodsFor:'bitmap/window creation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1636
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1637
createBitmapFromArray:anArray width:w height:h
2896
cad683a945dc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2871
diff changeset
  1638
    "create a monochrome, depth1 bitmap from a given (byte-)array.
cad683a945dc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2871
diff changeset
  1639
     The rows are aligned to a multiple of 8"
cad683a945dc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2871
diff changeset
  1640
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1641
    |bitmapId|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1642
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1643
    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1644
    bitmapId isNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1645
        self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1646
    ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1647
    ^ bitmapId
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1648
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1649
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1650
createBitmapFromFile:aString for:aForm
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1651
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1652
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1653
    |id w h|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1654
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1655
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1656
    int screen = __intVal(__INST(screen));
2531
e4d6bdae7bcf use quick-isString / isSymbol
Claus Gittinger <cg@exept.de>
parents: 2501
diff changeset
  1657
e4d6bdae7bcf use quick-isString / isSymbol
Claus Gittinger <cg@exept.de>
parents: 2501
diff changeset
  1658
    if (ISCONNECTED
5467
0685d08ef9b4 isStringLike / isArrayLike
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1659
     && __isStringLike(aString)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1660
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1661
        char *filename;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1662
        int status;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1663
        Pixmap newBitmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1664
        unsigned b_width, b_height;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1665
        int b_x_hot, b_y_hot;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1666
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1667
        filename = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1668
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1669
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1670
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1671
        status = XReadBitmapFile(dpy, RootWindow(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1672
                                 filename, &b_width, &b_height, &newBitmap,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1673
                                 &b_x_hot, &b_y_hot);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1674
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1675
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1676
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1677
        if ((status == BitmapSuccess)  && newBitmap) {
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1678
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1679
            __cnt_bitmap++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1680
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1681
            w = __MKSMALLINT(b_width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1682
            h = __MKSMALLINT(b_height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1683
            id = __MKEXTERNALADDRESS(newBitmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1684
        }
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1685
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1686
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1687
    id notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1688
        aForm setWidth:w height:h
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1689
    ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1690
    ^ id
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1691
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1692
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1693
createBitmapWidth:w height:h
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1694
    "allocate a bitmap on the Xserver, the contents is undefined
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1695
     (i.e. random). Return a bitmap id or nil"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1696
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1697
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1698
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1699
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1700
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1701
    Pixmap newBitmap;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1702
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1703
    if (__bothSmallInteger(w, h) && ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1704
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1705
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1706
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1707
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1708
        newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1709
                                       __intVal(w), __intVal(h), 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1710
        LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1711
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1712
        if (newBitmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1713
            __cnt_bitmap++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1714
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1715
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1716
        RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1717
    }
1838
040e4689dfcd oops - do not return self from failing primCreateBitmap
Claus Gittinger <cg@exept.de>
parents: 1835
diff changeset
  1718
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1719
    self primitiveFailedOrClosedConnection.
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1720
    ^ nil
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1721
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1722
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1723
createPixmapWidth:w height:h depth:d
48194c26a46c Initial revision
claus
parents:
diff changeset
  1724
    "allocate a pixmap on the Xserver, the contents is undefined
48194c26a46c Initial revision
claus
parents:
diff changeset
  1725
     (i.e. random). Return a bitmap id or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1726
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1727
    <context: #return>
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1728
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1729
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1730
    int screen = __intVal(__INST(screen));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1731
    Pixmap newBitmap;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1732
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1733
    if (__bothSmallInteger(w, h) && ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1734
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1735
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1736
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1737
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1738
        newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1739
                                       __intVal(w), __intVal(h), __intVal(d));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1740
        LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1741
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1742
        if (newBitmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1743
            __cnt_bitmap++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1744
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1745
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1746
        RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1747
    }
1424
29fb970f157f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1404
diff changeset
  1748
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1749
    self primitiveFailedOrClosedConnection.
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  1750
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1751
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1752
1468
9832c4017a70 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1462
diff changeset
  1753
createWindowFor:aView type:typeSymbol
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1754
		 origin:origin
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1755
		 extent:extent
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1756
		 minExtent:minExt
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1757
		 maxExtent:maxExt
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1758
		 borderWidth:bWidth
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1759
		 subViewOf:wsuperView
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1760
		 style:wStyle
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1761
		 inputOnly:winputOnly
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1762
		 label:wlabel
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1763
		 owner:wowner
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1764
		 icon:wicon iconMask:wiconMask
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1765
		 iconView:wiconView
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1766
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1767
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  1768
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1769
    |xpos ypos wwidth wheight minWidth minHeight maxWidth maxHeight
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1770
     bColorId wsuperViewId windowId isTopWindow
5525
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  1771
     weventMask bitGravity viewGravity vBgColor
5998
04c91c9d90f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5993
diff changeset
  1772
     vBgForm deepForm preferredVisual preferredDepth
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1773
     wiconId wiconMaskId wiconViewId windowGroupWindowId|
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1774
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  1775
    self isOpen ifFalse:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1776
	self primitiveFailedOrClosedConnection.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1777
	^ nil
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1778
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1779
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1780
    origin notNil ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1781
	xpos := origin x.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1782
	ypos := origin y.
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1783
    ] ifFalse:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1784
	xpos := ypos := 0.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1785
    ].
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1786
    extent notNil ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1787
	wwidth := extent x.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1788
	wheight := extent y.
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1789
    ] ifFalse:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1790
	wwidth := wheight := 100.
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1791
    ].
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1792
    minExt notNil ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1793
	minWidth := minExt x.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1794
	minHeight := minExt y
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1795
    ].
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1796
    maxExt notNil ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1797
	maxWidth := maxExt x.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1798
	maxHeight := maxExt y
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1799
    ].
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1800
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1801
    wsuperView notNil ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1802
	wsuperViewId := wsuperView id
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1803
    ] ifFalse:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1804
	isTopWindow := true.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1805
	aView class ~~ WindowGroupWindow ifTrue:[
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1806
	    windowGroupWindow isNil ifTrue:[
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1807
		self getWindowGroupWindow.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1808
	    ].
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1809
	    windowGroupWindowId := windowGroupWindow id.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1810
	].
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1811
	wicon notNil ifTrue:[
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1812
	    wiconId := wicon id.
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1813
	    wiconMask notNil ifTrue:[
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1814
		wiconMaskId := wiconMask id
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1815
	    ]
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1816
	].
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1817
	wiconView notNil ifTrue:[
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1818
	    wiconViewId := wiconView id
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1819
	].
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1820
    ].
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1821
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1822
    weventMask := aView eventMask.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1823
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1824
    preferredVisual := aView preferredVisual.
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1825
    preferredDepth := aView preferredDepth.
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1826
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1827
1898
e1b272aa6e82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1891
diff changeset
  1828
%{  /* STACK:64000 */ /* used to be 16000 - but VMS seems to need a lot */
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1829
    Display *dpy = myDpy;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  1830
    int screen = __intVal(__INST(screen));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1831
    Visual visual;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1832
    XGCValues xgcv;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1833
    XSetWindowAttributes xswa;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1834
    XSizeHints sizehints;
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1835
    int bw, bd, bg;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1836
    Window newWindow, parentWindow;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1837
    XFontStruct *f;
5525
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  1838
    Pixmap backPixmap = (Pixmap)0;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1839
    int flags = 0, depth, ioClass;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1840
    Atom WmDeleteWindowAtom, WmSaveYourselfAtom, WmProtocolsAtom;
4082
cb6eb58e8311 set MWM-Decoration-Hints
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  1841
    Atom WmQuitAppAtom, MotifWMHintsAtom;
4410
4001d5ec5fcf uniqueID for Alstom
Claus Gittinger <cg@exept.de>
parents: 4409
diff changeset
  1842
    Atom STXDeviceAtom, UUIDAtom;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1843
    Atom atoms[3];
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1844
    int atomCount = 0;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1845
48194c26a46c Initial revision
claus
parents:
diff changeset
  1846
    sizehints.flags = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1847
    sizehints.width = 100;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1848
    sizehints.height = 100;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1849
    sizehints.x = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1850
    sizehints.y = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1851
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1852
    if (__bothSmallInteger(wwidth, wheight)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1853
	sizehints.flags |= PSize;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1854
	sizehints.width = __intVal(wwidth);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1855
	sizehints.height = __intVal(wheight);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1856
    }
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1857
    if (__bothSmallInteger(xpos, ypos)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1858
	sizehints.flags |= PPosition;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1859
	sizehints.x = __intVal(xpos);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1860
	sizehints.y = __intVal(ypos);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1861
    }
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1862
    if (__bothSmallInteger(minWidth, minHeight)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1863
	sizehints.flags |= PMinSize;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1864
	sizehints.min_width = __intVal(minWidth);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1865
	sizehints.min_height = __intVal(minHeight);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1866
    }
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1867
    if (__bothSmallInteger(maxWidth, maxHeight)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1868
	sizehints.flags |= PMaxSize;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1869
	sizehints.max_width = __intVal(maxWidth);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1870
	sizehints.max_height = __intVal(maxHeight);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1871
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  1872
37
c2dc1832c0f1 *** empty log message ***
claus
parents: 36
diff changeset
  1873
    bg = WhitePixel(dpy, screen);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1874
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1875
    if (__isSmallInteger(bWidth)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1876
	bw = __intVal(bWidth);
46
7b331e9012fd *** empty log message ***
claus
parents: 44
diff changeset
  1877
    } else {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1878
	bw = 0;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1879
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  1880
72
3e84121988c3 *** empty log message ***
claus
parents: 70
diff changeset
  1881
    bd = BlackPixel(dpy, screen);
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1882
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1883
    if (__isExternalAddress(wsuperViewId)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1884
	parentWindow = __WindowVal(wsuperViewId);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1885
    } else {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1886
	parentWindow = RootWindow(dpy, screen);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1887
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  1888
1695
46d9101e4bee replaced isPopUp flag in #createWindow by a more general #style symbol argument
Claus Gittinger <cg@exept.de>
parents: 1694
diff changeset
  1889
    if (wStyle == @symbol(popUp))
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1890
	xswa.override_redirect = 1;
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1891
    else
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1892
	xswa.override_redirect = 0;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1893
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1894
    if (winputOnly == true)
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1895
	ioClass = InputOnly;
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1896
    else
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1897
	ioClass = InputOutput;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1898
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  1899
    if (__isSmallInteger(weventMask)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1900
	xswa.event_mask = __intVal(weventMask);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1901
    } else {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1902
	xswa.event_mask = 0;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1903
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  1904
48194c26a46c Initial revision
claus
parents:
diff changeset
  1905
    if (ioClass == InputOnly) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1906
	bw = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1907
	depth = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1908
	flags |= CWEventMask;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1909
    } else {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1910
	depth = DefaultDepth(dpy,screen);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1911
	flags |= CWEventMask | CWBorderPixel | CWOverrideRedirect;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1912
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1913
	if (backPixmap != (Pixmap)0) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1914
	    xswa.background_pixmap = backPixmap;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1915
	    flags |= CWBackPixmap;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1916
	} else {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1917
	    xswa.background_pixel = bg;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1918
	    flags |= CWBackPixel;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1919
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1920
	xswa.border_pixel = bd;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1921
    }
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1922
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1923
    visual.visualid = CopyFromParent;
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1924
    if (__isSmallInteger(preferredDepth)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1925
	depth = __intVal(preferredDepth);
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  1926
    }
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1927
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
  1928
150
5d0b9d669832 *** empty log message ***
claus
parents: 146
diff changeset
  1929
    if (preferredVisual != nil) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1930
	XVisualInfo vi;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1931
	int cls;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1932
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1933
	if (preferredVisual == @symbol(StaticGray))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1934
	    cls = StaticGray;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1935
	else if (preferredVisual == @symbol(GrayScale))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1936
	    cls = GrayScale;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1937
	else if (preferredVisual == @symbol(StaticColor))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1938
	    cls = StaticColor;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1939
	else if (preferredVisual == @symbol(PseudoColor))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1940
	    cls = PseudoColor;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1941
	else if (preferredVisual == @symbol(TrueColor))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1942
	    cls = TrueColor;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1943
	else if (preferredVisual == @symbol(DirectColor))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1944
	    cls = DirectColor;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1945
	else
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1946
	    cls = PseudoColor;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1947
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1948
	ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1949
	if (XMatchVisualInfo(dpy, screen, depth, cls, &vi)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1950
	    visual.visualid = vi.visualid;
163
claus
parents: 162
diff changeset
  1951
/*
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1952
	    console_fprintf(stderr, "visualId=%x\n", vi.visualid);
163
claus
parents: 162
diff changeset
  1953
*/
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1954
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1955
	LEAVE_XLIB();
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1956
    }
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1957
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1958
    ENTER_XLIB2();
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1959
    newWindow = XCreateWindow(dpy, parentWindow,
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1960
			   sizehints.x, sizehints.y,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1961
			   sizehints.width, sizehints.height,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1962
			   bw, depth, ioClass, &visual,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1963
			   flags, &xswa);
1974
3a780312fa2e preps for timeout handling
Claus Gittinger <cg@exept.de>
parents: 1960
diff changeset
  1964
    LEAVE_XLIB();
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
  1965
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1966
48194c26a46c Initial revision
claus
parents:
diff changeset
  1967
    if (! newWindow) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1968
	RETURN ( nil );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1969
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  1970
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1971
#ifdef COUNT_RESOURCES
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1972
    __cnt_view++;
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1973
#endif
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  1974
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1975
    /*
48194c26a46c Initial revision
claus
parents:
diff changeset
  1976
     * define its icon and name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1977
     * (only makes sense for topWindows)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1978
     */
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  1979
    if (isTopWindow == true) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1980
	XWMHints wmhints;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1981
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1982
	wmhints.flags = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1983
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1984
	if (__isExternalAddress(wiconId)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1985
	    wmhints.icon_pixmap = __PixmapVal(wiconId);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1986
	    wmhints.flags = IconPixmapHint;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1987
	    if (__isExternalAddress(wiconMaskId)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1988
		wmhints.icon_mask = __PixmapVal(wiconMaskId);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1989
		wmhints.flags |= IconMaskHint;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1990
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1991
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1992
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1993
	if (__isExternalAddress(windowGroupWindowId)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1994
	    wmhints.window_group = __WindowVal(windowGroupWindowId);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1995
	    wmhints.flags |= WindowGroupHint;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1996
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1997
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1998
	if (__isExternalAddress(wiconViewId)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  1999
	    wmhints.flags |= IconWindowHint;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2000
	    wmhints.icon_window = __WindowVal(wiconViewId);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2001
	};
5525
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2002
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2003
/*
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2004
	wmhints.flags |= InputHint;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2005
	wmhints.input = True;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2006
*/
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2007
	ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2008
	XSetWMHints(dpy, newWindow, &wmhints);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2009
	XSetWMNormalHints(dpy, newWindow, &sizehints);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2010
	LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2011
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2012
	/*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2013
	 * get atoms first (if not already known)
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2014
	 */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2015
	if (__INST(protocolsAtom) == nil) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2016
	    ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2017
	    WmProtocolsAtom = XInternAtom(dpy, "WM_PROTOCOLS", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2018
	    __INST(protocolsAtom) = __MKATOMOBJ(WmProtocolsAtom);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2019
#ifdef USE_SAVEYOURSELF_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2020
	    WmSaveYourselfAtom = XInternAtom(dpy, "WM_SAVE_YOURSELF", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2021
	    __INST(saveYourselfAtom) = __MKATOMOBJ(WmSaveYourselfAtom);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2022
#endif
48194c26a46c Initial revision
claus
parents:
diff changeset
  2023
#ifdef USE_QUIT_APP_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2024
	    WmQuitAppAtom = XInternAtom(dpy, "_WM_QUIT_APP", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2025
	    __INST(quitAppAtom) = __MKATOMOBJ(WmQuitAppAtom);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2026
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2027
	    WmDeleteWindowAtom = XInternAtom(dpy, "WM_DELETE_WINDOW", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2028
	    __INST(deleteWindowAtom) = __MKATOMOBJ(WmDeleteWindowAtom);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2029
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2030
	    UUIDAtom = XInternAtom(dpy, "UUID", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2031
	    __INST(uuidAtom) = __MKATOMOBJ(UUIDAtom);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2032
	    STXDeviceAtom = XInternAtom(dpy, "STX_DEVICE_ID", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2033
	    __INST(stxDeviceAtom) = __MKATOMOBJ(STXDeviceAtom);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2034
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2035
	    LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2036
	} else {
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2037
#ifdef USE_QUIT_APP_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2038
	    WmQuitAppAtom = __AtomVal(__INST(quitAppAtom));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2039
#else
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2040
	    WmQuitAppAtom = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2041
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2042
	    WmProtocolsAtom = __AtomVal(__INST(protocolsAtom));
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2043
	    WmDeleteWindowAtom = __AtomVal(__INST(deleteWindowAtom));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2044
#ifdef USE_SAVEYOURSELF_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2045
	    WmSaveYourselfAtom = __AtomVal(__INST(saveYourselfAtom));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2046
#else
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2047
	    WmSaveYourselfAtom = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2048
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2049
	    UUIDAtom = __AtomVal(__INST(uuidAtom));;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2050
	    STXDeviceAtom = __AtomVal(__INST(stxDeviceAtom));;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2051
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2052
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2053
	/*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2054
	 * tell window manager to not kill us but send an event instead
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2055
	 */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2056
	atoms[0] = WmDeleteWindowAtom; atomCount++;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2057
#ifdef USE_SAVEYOURSELF_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2058
	atoms[atomCount] = WmSaveYourselfAtom; atomCount++;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2059
#endif
48194c26a46c Initial revision
claus
parents:
diff changeset
  2060
#ifdef USE_QUIT_APP_ATOM
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2061
	atoms[atomCount] = WmQuitAppAtom; atomCount++;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2062
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2063
	ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2064
	XChangeProperty(dpy, newWindow, WmProtocolsAtom, XA_ATOM,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2065
			32, PropModeReplace, (unsigned char *)atoms, atomCount);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2066
	LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2067
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2068
	/*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2069
	 * an optional unique id (to mark stx-windows)
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2070
	 */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2071
	if (__isBytes(__INST(uniqueDeviceID))) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2072
	    int numUUIDBytes = __byteArraySize(__INST(uniqueDeviceID));
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2073
	    unsigned char uuidBytes[32];
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2074
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2075
	    if (numUUIDBytes <= sizeof(uuidBytes)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2076
		Atom uuidAtom;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2077
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2078
		bcopy(__byteArrayVal(__INST(uniqueDeviceID)), uuidBytes, numUUIDBytes);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2079
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2080
		ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2081
		XChangeProperty (dpy, newWindow, STXDeviceAtom, UUIDAtom, 8, PropModeReplace,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2082
				 uuidBytes, numUUIDBytes );
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2083
		LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2084
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2085
	}
5473
d5687a021b55 __isByteArray() to __isByteArrayLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 5467
diff changeset
  2086
5886
e72320525e18 comment/format in: #setWindowType:in:
Stefan Vogel <sv@exept.de>
parents: 5885
diff changeset
  2087
#ifdef SUPPORT_MOTIF_WM_HINTS
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2088
	/*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2089
	 * less decoration
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2090
	 */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2091
	if ((wStyle == @symbol(undecorated))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2092
	 || (wStyle == @symbol(dialog2))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2093
	 || (wStyle == @symbol(notitle))
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2094
	) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2095
	    if (__INST(motifWMHintsAtom) == nil) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2096
		ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2097
		MotifWMHintsAtom = XInternAtom(dpy, "_MOTIF_WM_HINTS", False);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2098
		__INST(motifWMHintsAtom) = __MKATOMOBJ(MotifWMHintsAtom);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2099
		LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2100
	    } else {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2101
		MotifWMHintsAtom = __AtomVal(__INST(motifWMHintsAtom));
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2102
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2103
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2104
	    {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2105
		struct hints {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2106
		    unsigned long flags;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2107
		    unsigned long functions;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2108
		    unsigned long decorations;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2109
		    long input_mode;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2110
		    unsigned long status;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2111
		} mvm_hints;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2112
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2113
		if (wStyle == @symbol(undecorated)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2114
		    mvm_hints.decorations = MWM_DECOR_NONE;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2115
		}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2116
		if (wStyle == @symbol(dialog2)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2117
		    mvm_hints.decorations = MWM_DECOR_BORDER
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2118
					    | MWM_DECOR_RESIZEH
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2119
					    | MWM_DECOR_TITLE
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2120
					    /* | MWM_DECOR_MENU */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2121
					    /* | MWM_DECOR_MINIMIZE */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2122
					    /* | MWM_DECOR_MAXIMIZE */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2123
					    ;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2124
		}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2125
		if (wStyle == @symbol(notitle)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2126
		    mvm_hints.decorations = MWM_DECOR_BORDER
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2127
					    /* | MWM_DECOR_RESIZEH  */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2128
					    /* | MWM_DECOR_TITLE    */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2129
					    /* | MWM_DECOR_MENU     */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2130
					    /* | MWM_DECOR_MINIMIZE */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2131
					    /* | MWM_DECOR_MAXIMIZE */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2132
					    ;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2133
		}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2134
		mvm_hints.flags =  MWM_HINTS_DECORATIONS;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2135
		ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2136
		XChangeProperty (dpy, newWindow, MotifWMHintsAtom,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2137
				     MotifWMHintsAtom, 32, PropModeReplace,
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2138
				     (unsigned char*)&mvm_hints, 5 );
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2139
		LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2140
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2141
	}
4090
b1dc981c8b10 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4086
diff changeset
  2142
#endif /* SUPPORT_MOTIF_WM_HINTS */
4082
cb6eb58e8311 set MWM-Decoration-Hints
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  2143
    }
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2144
1913
cd9259612040 eliminate MKOBJ & MKCP (use MKEXTERNALADDRESS & externalAddressVal)
Claus Gittinger <cg@exept.de>
parents: 1906
diff changeset
  2145
    windowId = __MKEXTERNALADDRESS(newWindow);
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  2146
%}.
5886
e72320525e18 comment/format in: #setWindowType:in:
Stefan Vogel <sv@exept.de>
parents: 5885
diff changeset
  2147
e72320525e18 comment/format in: #setWindowType:in:
Stefan Vogel <sv@exept.de>
parents: 5885
diff changeset
  2148
"/    (wStyle ~= nil and:[wStyle ~= #normal]) ifTrue:[
e72320525e18 comment/format in: #setWindowType:in:
Stefan Vogel <sv@exept.de>
parents: 5885
diff changeset
  2149
"/        self setWindowType:wStyle in:windowId.
e72320525e18 comment/format in: #setWindowType:in:
Stefan Vogel <sv@exept.de>
parents: 5885
diff changeset
  2150
"/    ].
5525
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2151
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2152
    (wsuperView isNil "this is a topwindow"
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2153
     and:[wlabel notEmptyOrNil]) ifTrue:[
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2154
	self
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2155
	    setIconName:wlabel in:windowId;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2156
	    setWindowName:wlabel in:windowId.
5525
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2157
    ].
9aae1d80c58e comment/format in: #initializeFor:
Stefan Vogel <sv@exept.de>
parents: 5510
diff changeset
  2158
5568
3d18b7fa928a changed: #createWindowFor:type:origin:extent:minExtent:maxExtent:borderWidth:subViewOf:style:inputOnly:label:owner:icon:iconMask:iconView:
Stefan Vogel <sv@exept.de>
parents: 5528
diff changeset
  2159
    self addKnownView:aView withId:windowId.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2160
    ^ windowId
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  2161
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
  2162
    "Modified: / 09-01-2013 / 10:43:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2163
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2164
48194c26a46c Initial revision
claus
parents:
diff changeset
  2165
destroyGC:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2166
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2167
    <context: #return>
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2168
%{
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2169
    /*
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2170
     * ignore closed connection
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2171
     */
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2172
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2173
        RETURN ( self );
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2174
    }
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2175
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2176
    if (__isExternalAddress(aGCId)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2177
        GC gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2178
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2179
        if (gc) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2180
            __ExternalAddressInstPtr(aGCId)->e_address = NULL;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2181
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2182
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2183
            XFreeGC(myDpy, gc);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2184
            LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2185
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2186
            __cnt_gc--;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2187
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2188
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2189
            console_fprintf(stderr, "XWorkstation [warning]: trying to destroy GC twice\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2190
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2191
        RETURN ( self );
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2192
    }
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2193
%}.
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2194
    self primitiveFailed
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2195
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2196
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2197
destroyPixmap:aDrawableId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2198
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2199
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2200
%{
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2201
    /*
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2202
     * ignore closed connection
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2203
     */
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2204
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2205
        RETURN ( self );
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2206
    }
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2207
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2208
    if (__isExternalAddress(aDrawableId)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2209
        Pixmap pix = __PixmapVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2210
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2211
        if (pix) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2212
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2213
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2214
            XFreePixmap(myDpy, pix);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2215
            LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2216
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2217
            __cnt_bitmap--;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2218
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2219
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2220
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2221
        RETURN ( self );
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2222
    }
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2223
%}.
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2224
    self primitiveFailed
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2225
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2226
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2227
destroyView:aViewOrNil withId:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2228
    self primDestroyViewWithId:aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2229
    self removeKnownView:aViewOrNil withId:aWindowId.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2230
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2231
48194c26a46c Initial revision
claus
parents:
diff changeset
  2232
dpsContextFor:aDrawableId and:aGCId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2233
3794
3b5fbd07d46d Delete property in X-Server when no longer used
Stefan Vogel <sv@exept.de>
parents: 3792
diff changeset
  2234
    <context: #return>
3b5fbd07d46d Delete property in X-Server when no longer used
Stefan Vogel <sv@exept.de>
parents: 3792
diff changeset
  2235
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2236
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2237
#ifdef XXDPS
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2238
    int screen = __intVal(__INST(screen));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2239
    DPSContext dps;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2240
    int height;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2241
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  2242
    if (__isExternalAddress(aDrawableId)
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  2243
     && __isExternalAddress(aGCId)
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  2244
     && ISCONNECTED) {
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
  2245
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2246
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2247
        dps = XDPSCreateContext(myDpy, __DrawableVal(aDrawableId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2248
                                       __GCVal(aGCId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2249
                                       0, height, 0, colormap, NULL, 0,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2250
                                       XDPSDefaultTextBackstop,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2251
                                       XDPSDefaultErrorProc,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2252
                                       NULL);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2253
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2254
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2255
        RETURN ( dps ? __MKEXTERNALADDRESS(dps) : nil );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2256
    }
48194c26a46c Initial revision
claus
parents:
diff changeset
  2257
#endif
1838
040e4689dfcd oops - do not return self from failing primCreateBitmap
Claus Gittinger <cg@exept.de>
parents: 1835
diff changeset
  2258
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2259
    self primitiveFailedOrClosedConnection.
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  2260
    ^ nil
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2261
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2262
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2263
gcFor:aDrawableId
132
claus
parents: 129
diff changeset
  2264
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2265
    <context: #return>
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2266
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2267
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2268
    GC gc;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2269
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2270
    if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
  2271
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2272
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2273
        gc = XCreateGC(myDpy, __DrawableVal(aDrawableId), 0L, (XGCValues *)0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2274
        LEAVE_XLIB();
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2275
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2276
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2277
        if (gc)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2278
            __cnt_gc++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2279
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2280
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2281
        RETURN ( gc ? __MKEXTERNALADDRESS(gc) : nil );
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2282
    }
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2283
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2284
    self primitiveFailedOrClosedConnection.
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2285
    ^ nil
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2286
!
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2287
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2288
gcForBitmap:aDrawableId
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2289
    "with X, this is the same as a normal gc"
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1103
diff changeset
  2290
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2291
    ^ self gcFor:aDrawableId
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2292
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2293
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2294
primCreateBitmapFromArray:anArray width:w height:h
154
claus
parents: 153
diff changeset
  2295
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2296
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2297
154
claus
parents: 153
diff changeset
  2298
%{  /* UNLIMITEDSTACK */
claus
parents: 153
diff changeset
  2299
1207
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  2300
    Display *dpy;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2301
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2302
    Pixmap newBitmap;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2303
    unsigned int b_width, b_height;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2304
    REGISTER unsigned char *cp;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2305
    REGISTER unsigned char *pBits;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2306
    unsigned char *b_bits, *allocatedBits;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2307
    int index, row;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2308
    REGISTER int col;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2309
    unsigned bits;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2310
    static char reverseBitTable[256];
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2311
    static firstCall = 1;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2312
    int nBytes;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2313
    unsigned char fastBits[10000];
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2314
    OBJ num, *op;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2315
    int bytesPerRow;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2316
898
677e010d0cf8 exit from image restart, if connection is refused
Claus Gittinger <cg@exept.de>
parents: 892
diff changeset
  2317
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2318
        RETURN (nil);
898
677e010d0cf8 exit from image restart, if connection is refused
Claus Gittinger <cg@exept.de>
parents: 892
diff changeset
  2319
    }
1207
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  2320
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  2321
    dpy = myDpy;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2322
    if (firstCall) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2323
        for (index=0; index < 256; index++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2324
            int t = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2325
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2326
            if (index & 128) t |=   1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2327
            if (index &  64) t |=   2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2328
            if (index &  32) t |=   4;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2329
            if (index &  16) t |=   8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2330
            if (index &   8) t |=  16;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2331
            if (index &   4) t |=  32;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2332
            if (index &   2) t |=  64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2333
            if (index &   1) t |= 128;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2334
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2335
            reverseBitTable[index] = t;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2336
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2337
        firstCall = 0;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2338
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2339
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2340
    if (__bothSmallInteger(w, h) && _isNonNilObject(anArray)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2341
        newBitmap = (Pixmap)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2342
        b_width = __intVal(w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2343
        b_height = __intVal(h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2344
        bytesPerRow = (b_width + 7) / 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2345
        nBytes = b_height * bytesPerRow;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2346
        if (nBytes < sizeof(fastBits)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2347
            cp = b_bits = fastBits;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2348
            allocatedBits = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2349
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2350
            cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2351
            if (! cp) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2352
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2353
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2354
        if (__isArrayLike(anArray)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2355
            index = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2356
            op = &(__ArrayInstPtr(anArray)->a_element[index - 1]);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2357
            for (row = b_height; row; row--) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2358
                for (col = bytesPerRow; col; col--) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2359
                    num = *op++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2360
                    if (__isSmallInteger(num)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2361
                        bits = __intVal(num);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2362
                    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2363
                        bits = __longIntVal(num);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2364
                        if (bits == 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2365
                            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2366
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2367
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2368
                    *cp++ = reverseBitTable[bits & 0xFF];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2369
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2370
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2371
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2372
            if (__isByteArrayLike(anArray)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2373
                pBits = __ByteArrayInstPtr(anArray)->ba_element;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2374
                for (col = b_height*bytesPerRow; col; col--) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2375
                    *cp++ = reverseBitTable[*pBits++];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2376
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2377
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2378
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2379
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2380
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2381
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2382
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2383
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2384
        newBitmap = XCreateBitmapFromData(dpy, RootWindow(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2385
                                               (char *)b_bits,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2386
                                               b_width, b_height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2387
        LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2388
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2389
        if (newBitmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2390
            __cnt_bitmap++;
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2391
#endif
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2392
3131
88293c577ba6 got rid of BEGIN_INTERRUPTS_BLOCKED .. END_INTERRUPTS_BLOCKED;
Claus Gittinger <cg@exept.de>
parents: 3079
diff changeset
  2393
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2394
fail: ;
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2395
        if (allocatedBits)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2396
            free(allocatedBits);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2397
        RETURN ( newBitmap ? __MKEXTERNALADDRESS(newBitmap) : nil );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2398
    }
1838
040e4689dfcd oops - do not return self from failing primCreateBitmap
Claus Gittinger <cg@exept.de>
parents: 1835
diff changeset
  2399
%}.
040e4689dfcd oops - do not return self from failing primCreateBitmap
Claus Gittinger <cg@exept.de>
parents: 1835
diff changeset
  2400
    ^ nil
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2401
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2402
3228
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2403
primCreateWindowType:t origin:o extent:e minExtent:minE maxExtent:maxE borderWidth:bw superViewId:sv style:st inputOnly:i label:l ownerId:oId iconId:ic iconMaskId:im iconViewId:iv
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2404
    "for rel5 only"
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2405
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2406
    ^ self primitiveFailedOrClosedConnection
3228
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2407
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2408
!
c4d942d8c69a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3227
diff changeset
  2409
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2410
primDestroyViewWithId:aWindowId
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2411
    <context: #return>
3250
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2412
%{
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2413
    if (! ISCONNECTED) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2414
	RETURN ( self );
3250
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2415
    }
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2416
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2417
    if (__isExternalAddress(aWindowId)) {
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2418
	Window win = __WindowVal(aWindowId);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2419
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2420
	if (win) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2421
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2422
	    ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2423
	    XDestroyWindow(myDpy, win);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2424
	    LEAVE_XLIB();
3250
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2425
#ifdef COUNT_RESOURCES
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2426
	    __cnt_view--;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2427
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2428
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
  2429
	}
3250
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2430
    }
250ee58a0634 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3245
diff changeset
  2431
%}
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2432
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2433
5898
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2434
!XWorkstation methodsFor:'clipboard'!
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2435
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2436
getPrimaryBuffer
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2437
    "Returns the contents of PRIMARY selection buffer"
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2438
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2439
    ^ primaryBuffer
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2440
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2441
    "Created: / 27-03-2012 / 14:51:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2442
!
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2443
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2444
primaryBufferAsString
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2445
    "return my current selection as a string"
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2446
5938
f5d6189257d4 comment/format in: #supportedTargetAtoms
Stefan Vogel <sv@exept.de>
parents: 5936
diff changeset
  2447
    ^ self class bufferAsString:self getPrimaryBuffer.
5898
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2448
!
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2449
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2450
setPrimaryBuffer:aString
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2451
    "Sets the contents of PRIMARY selection."
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2452
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2453
    primaryBuffer := aString.
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2454
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2455
    "Created: / 27-03-2012 / 14:41:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2456
!
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2457
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2458
setPrimaryText:aString ownerView:aView
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2459
    "Set the PRIMARY selection - both the local one, and tell the display
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2460
     that we have changed it (i.e. place it into the PRIMARY)."
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2461
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2462
    |s viewID|
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2463
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2464
    self setPrimaryBuffer:aString.
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2465
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2466
    s := aString ? ''.
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2467
    s isString ifFalse:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2468
        s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
5898
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2469
    ].
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2470
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2471
    viewID := aView id.
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2472
    viewID notNil ifTrue:[ "/ if the view is not already closed
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2473
        "/ for now - should add support to pass emphasis information too
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2474
        s := s string.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2475
        self setPrimaryText:s owner:viewID.
5898
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2476
    ]
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2477
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2478
    "Created: / 27-03-2012 / 14:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2479
! !
3fbf04bffa7a Support for X's PRIMARY selection
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5893
diff changeset
  2480
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2481
!XWorkstation methodsFor:'color stuff'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2482
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2483
colorCell
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2484
    "allocate a color cell - return the color index (i.e. colorID).
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2485
     This method will return nil for StaticGrey, StaticGrey and TrueColor displays."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2486
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2487
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2488
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2489
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2490
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2491
    XColor color;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2492
    unsigned long dummy;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2493
    Status ok;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2494
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2495
    if (ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2496
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2497
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2498
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2499
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2500
        ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2501
                                   &dummy, 0, &color.pixel, 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2502
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2503
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2504
        if (ok) {
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2505
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2506
            __cnt_color++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2507
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2508
            RETURN ( __MKSMALLINT(color.pixel) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2509
        }
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2510
    }
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2511
%}.
43
1d44cc4da884 *** empty log message ***
claus
parents: 37
diff changeset
  2512
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2513
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2514
48194c26a46c Initial revision
claus
parents:
diff changeset
  2515
colorNamed:aString
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2516
    "allocate a color with color name - return the color index (i.e. colorID).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2517
     Dont use this method, colornames are mostly X specific"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2518
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2519
    <context: #return>
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2520
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2521
48194c26a46c Initial revision
claus
parents:
diff changeset
  2522
    char *colorname;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2523
    XColor scolor, ecolor;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2524
    int screen = __intVal(__INST(screen));
850
Claus Gittinger <cg@exept.de>
parents: 847
diff changeset
  2525
    int id;
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2526
    Status ok;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2527
2531
e4d6bdae7bcf use quick-isString / isSymbol
Claus Gittinger <cg@exept.de>
parents: 2501
diff changeset
  2528
    if (ISCONNECTED
5467
0685d08ef9b4 isStringLike / isArrayLike
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  2529
     && __isStringLike(aString)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2530
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2531
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2532
        colorname = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2533
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2534
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2535
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2536
        ok = XParseColor(dpy, DefaultColormap(dpy, screen), colorname, &ecolor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2537
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2538
        if (ok) {
847
f7c402bc5983 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 846
diff changeset
  2539
#ifdef QUICK_TRUE_COLORS
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2540
            if (__INST(visualType) == @symbol(TrueColor)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2541
                id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2542
                id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2543
                id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2544
                RETURN ( __MKSMALLINT(id) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2545
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2546
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2547
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2548
            ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2549
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2550
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2551
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2552
        if (! ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2553
            RETURN ( nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2554
        }
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2555
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2556
        __cnt_color++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2557
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2558
        RETURN ( __MKSMALLINT(ecolor.pixel) );
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2559
    }
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2560
%}.
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2561
    ^ super colorNamed:aString
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2562
!
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2563
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2564
colorScaledRed:r scaledGreen:g scaledBlue:b
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2565
    "allocate a color with rgb values (0..16rFFFF) - return the color index (i.e. colorID)"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2566
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2567
    <context: #return>
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2568
%{
898
677e010d0cf8 exit from image restart, if connection is refused
Claus Gittinger <cg@exept.de>
parents: 892
diff changeset
  2569
    Display *dpy;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2570
    XColor ecolor;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2571
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2572
    Status ok;
846
49a4732dec95 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  2573
    int id;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2574
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2575
    if (__bothSmallInteger(r, g)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2576
     && __isSmallInteger(b)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2577
     && ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2578
        ecolor.red = __intVal(r);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2579
        ecolor.green= __intVal(g);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2580
        ecolor.blue = __intVal(b);
846
49a4732dec95 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  2581
#ifdef QUICK_TRUE_COLORS
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2582
        if (__INST(visualType) == @symbol(TrueColor)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2583
            id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2584
            id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2585
            id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2586
            RETURN ( __MKSMALLINT(id) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2587
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2588
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2589
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2590
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2591
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2592
        ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2593
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2594
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2595
        if (! ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2596
            RETURN ( nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2597
        }
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2598
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2599
        __cnt_color++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2600
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2601
        RETURN ( __MKSMALLINT(ecolor.pixel) );
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2602
    }
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2603
%}.
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2604
    ^ super colorScaledRed:r scaledGreen:g scaledBlue:b
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2605
!
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2606
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2607
deviceColorValueToPercent:aDeviceValue
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2608
    "given a color-component value in percent (0..65k), return the corresponding
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2609
     x-component value (0..100)"
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2610
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2611
    ^ (100.0 * aDeviceValue / 16rFFFF)
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2612
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2613
    "
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2614
     Display deviceColorValueToPercent:0
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2615
     Display deviceColorValueToPercent:16r8000
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2616
     Display deviceColorValueToPercent:16rFFFF
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2617
    "
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2618
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2619
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2620
freeColor:colorIndex
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2621
    "free a display color when its no longer needed"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2622
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2623
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2624
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2625
1207
274dbb13f15a always check if display connection is valid, before doing anything
Claus Gittinger <cg@exept.de>
parents: 1206
diff changeset
  2626
    Display *dpy;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2627
    unsigned long color;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2628
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2629
846
49a4732dec95 dont XAlloc/XFree colors on TrueColor systems
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  2630
#ifdef QUICK_TRUE_COLORS
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2631
    if (__INST(visualType) == @symbol(TrueColor)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2632
        /* no need to do anything on TrueColor displays ... */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2633
        RETURN (self);
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2634
    }
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2635
#endif
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2636
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2637
    /*
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2638
     * ignore closed connection
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2639
     */
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2640
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2641
        RETURN (self);
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2642
    }
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2643
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2644
    if (__isSmallInteger(colorIndex)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2645
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2646
        color = (long) __intVal(colorIndex);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2647
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2648
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2649
        XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2650
        LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2651
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2652
        __cnt_color--;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2653
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2654
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2655
        RETURN ( self );
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2656
    }
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2657
%}.
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2658
    self primitiveFailed
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2659
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2660
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2661
getScaledRGBFrom:index
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2662
    "get rgb components (0 .. 16rFFFF) of color in map at:index,
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2663
     and return a 3-element array containing them"
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2664
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2665
    <context: #return>
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2666
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2667
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2668
    XColor color;
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2669
    int sr, sg, sb;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2670
    int bits, scale, shift;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2671
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2672
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2673
     && __isSmallInteger(index)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2674
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2675
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2676
        color.pixel = __intVal(index);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2677
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2678
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2679
        XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2680
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2681
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2682
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2683
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2684
         * have to compensate for an error in X ?, which does not scale
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2685
         * colors correctly if lesser than 16bits are valid in a color,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2686
         * (for example, color white on a 4bitsPerRGB server will Return
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2687
         * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2688
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2689
        bits = __intVal(__INST(bitsPerRGB));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2690
        scale = (1<<bits) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2691
        shift = 16 - bits;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2692
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2693
        sr = ((double)(color.red>>shift) / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2694
        sg = ((double)(color.green>>shift) / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2695
        sb = ((double)(color.blue>>shift) / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2696
        RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2697
    }
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2698
%}.
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2699
    ^ super getScaledRGBFrom:index
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2700
!
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2701
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2702
getScaledRGBFromName:colorName
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2703
    "get rgb components (0..16rFFFF) of color named colorName,
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2704
     and return a 3-element array containing them"
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2705
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2706
%{
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2707
    int screen = __intVal(__INST(screen));
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2708
    XColor color;
5034
c2e7d8a07da8 Some machines (hppa) have alignment problems, when casting something unaligned
Stefan Vogel <sv@exept.de>
parents: 5033
diff changeset
  2709
    double dr, dg, db;
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2710
    int sr, sg, sb;
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2711
    int bits, scale, shift;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2712
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2713
    if (ISCONNECTED
5467
0685d08ef9b4 isStringLike / isArrayLike
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  2714
     && __isStringLike(colorName)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2715
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2716
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2717
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2718
        if (XParseColor(dpy, DefaultColormap(dpy, screen),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2719
                             (char *) __stringVal(colorName), &color)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2720
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2721
             * have to compensate for an error in X ?, which does not scale
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2722
             * colors correctly if lesser than 16bits are valid in a color,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2723
             * (for example, color white on a 4bitsPerRGB server will Return
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2724
             * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2725
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2726
            bits = __intVal(__INST(bitsPerRGB));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2727
            scale = (1<<bits) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2728
            shift = 16 - bits;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2729
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2730
            /* do assignment to doubles (no cast) - avoid alignment problems in HPPA */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2731
            dr = color.red>>shift;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2732
            dg = color.green>>shift;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2733
            db = color.blue>>shift;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2734
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2735
            sr = (dr / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2736
            sg = (dg / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2737
            sb = (db / scale) * 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2738
            RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2739
        }
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2740
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2741
    }
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2742
%}.
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2743
    ^ super getScaledRGBFromName:colorName
5034
c2e7d8a07da8 Some machines (hppa) have alignment problems, when casting something unaligned
Stefan Vogel <sv@exept.de>
parents: 5033
diff changeset
  2744
c2e7d8a07da8 Some machines (hppa) have alignment problems, when casting something unaligned
Stefan Vogel <sv@exept.de>
parents: 5033
diff changeset
  2745
    "
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2746
        Screen current getScaledRGBFromName:'red'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2747
        Screen current getScaledRGBFromName:'orange'
5034
c2e7d8a07da8 Some machines (hppa) have alignment problems, when casting something unaligned
Stefan Vogel <sv@exept.de>
parents: 5033
diff changeset
  2748
    "
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2749
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2750
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2751
listOfAvailableColors
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2752
    "return a list of all available colornames.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2753
     This should not be used, since colornames are very
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2754
     display-specific (here X-specific)."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2755
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2756
    |aStream list line index colorName|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2757
3814
0d856538e64f Handle openErrorSignal in preparition for change openErrorSignal
Stefan Vogel <sv@exept.de>
parents: 3806
diff changeset
  2758
    aStream := '/usr/lib/X11/rgb.txt' asFilename readStreamOrNil.
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2759
    aStream isNil ifTrue:[^ nil].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2760
    list := OrderedCollection new.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2761
    [aStream atEnd] whileFalse:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2762
        line := aStream nextLine.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2763
        line notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2764
            "skip the r/g/b numbers"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2765
            index := 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2766
            [(line at:index) isSeparator] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2767
            [(line at:index) isDigit] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2768
            [(line at:index) isSeparator] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2769
            [(line at:index) isDigit] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2770
            [(line at:index) isSeparator] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2771
            [(line at:index) isDigit] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2772
            [(line at:index) isSeparator] whileTrue:[index := index + 1].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2773
            colorName := line copyFrom:index.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2774
            ((colorName occurrencesOf:(Character space)) == 0) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2775
                list add:colorName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2776
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2777
        ]
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2778
    ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2779
    aStream close.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2780
    ^ list sort
1047
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2781
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2782
    "
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2783
     Screen current listOfAvailableColors
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2784
    "
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2785
b1ab39266b10 Fix #listOfAvailableColors.
Stefan Vogel <sv@exept.de>
parents: 1046
diff changeset
  2786
    "Modified: 11.9.1996 / 15:26:28 / stefan"
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2787
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2788
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2789
percentToDeviceColorValue:aPercentage
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2790
    "given a color-component value in percent (0..100), return the corresponding
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2791
     x-component value (0..65k) as an integer"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2792
3220
e3e2f81a99df reorganized color protocl
Claus Gittinger <cg@exept.de>
parents: 3216
diff changeset
  2793
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2794
%{  /* NOCONTEXT */
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2795
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2796
    if (__isSmallInteger(aPercentage)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2797
        RETURN ( __MKSMALLINT(0xFFFF * __intVal(aPercentage) / 100) );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2798
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2799
    if (__isFloat(aPercentage)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2800
        RETURN ( __MKSMALLINT(0xFFFF * (int)(__floatVal(aPercentage)) / 100) );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2801
    }
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2802
%}.
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2803
    ^ (16rFFFF * aPercentage / 100) rounded
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2804
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2805
892
602b15686c95 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  2806
setColor:index scaledRed:sred scaledGreen:sgreen scaledBlue:sblue
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2807
    "change color in map at:index to rgb (0..16rFFFF).
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2808
     This method is a noop for StaticGrey, StaticGrey and TrueColor displays."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2809
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2810
    <context: #return>
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2811
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2812
48194c26a46c Initial revision
claus
parents:
diff changeset
  2813
    char *colorname;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2814
    XColor color;
555
2705be333c5f underscore macro cleanup
Claus Gittinger <cg@exept.de>
parents: 551
diff changeset
  2815
    int screen = __intVal(__INST(screen));
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2816
    int r, g, b;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2817
    int ok = 1;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2818
892
602b15686c95 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  2819
    if (__isSmallInteger(sred))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2820
        r = __intVal(sred);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2821
    else ok = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2822
892
602b15686c95 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  2823
    if (__isSmallInteger(sgreen))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2824
        g = __intVal(sgreen);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2825
    else ok = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2826
892
602b15686c95 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  2827
    if (__isSmallInteger(sblue))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2828
        b = __intVal(sblue);
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2829
    else ok = 0;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2830
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2831
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2832
     && __isSmallInteger(index) && ok) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2833
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2834
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2835
        color.pixel = __intVal(index);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2836
        color.red = r;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2837
        color.green = g;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2838
        color.blue = b;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2839
        color.flags = DoRed | DoGreen | DoBlue;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2840
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2841
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2842
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2843
        XStoreColor(dpy, DefaultColormap(dpy, screen), &color);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2844
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2845
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2846
        RETURN ( self );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2847
    }
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2848
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2849
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2850
! !
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2851
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2852
!XWorkstation methodsFor:'cursor stuff'!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2853
1563
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2854
builtInCursorShapes
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2855
    "return a collection of standard cursor names.
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2856
     Those are built into the XServer and need not be created as
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2857
     user cursors.
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2858
     (actually, there are more than those below ...)"
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2859
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2860
    "/ if you add something here, also add to #shapeNumberFromCursor ...
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2861
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2862
    ^ #(
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2863
        #upLeftArrow            "/ XC_top_left_arrow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2864
        #upRightHand            "/ XC_hand1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2865
        #upDownArrow            "/ XC_sb_v_double_arrow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2866
        #leftRightArrow         "/ XC_sb_h_double_arrow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2867
        #upLimitArrow           "/ XC_top_side
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2868
        #downLimitArrow         "/ XC_bottom_side
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2869
        #leftLimitArrow         "/ XC_left_side
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2870
        #rightLimitArrow        "/ XC_right_side
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2871
        #text                   "/ XC_xterm
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2872
        #upRightArrow           "/ XC_draft_large
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2873
        #leftHand               "/ XC_hand2
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2874
        #questionMark           "/ XC_question_arrow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2875
        #cross                  "/ XC_X_cursor
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2876
        #wait                   "/ XC_watch
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2877
        #crossHair              "/ XC_tcross
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2878
        #origin                 "/ XC_ul_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2879
        #topLeft                "/ XC_ul_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2880
        #corner                 "/ XC_lr_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2881
        #bottomRight            "/ XC_lr_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2882
        #topRight               "/ XC_ur_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2883
        #bottomLeft             "/ XC_ll_angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2884
        #square                 "/ XC_dotbox
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2885
        #fourWay                "/ XC_fleur
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2886
        #crossCursor            "/ XC_X_cursor
1563
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2887
      )
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2888
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2889
    "Created: 8.4.1997 / 10:12:30 / cg"
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2890
    "Modified: 8.4.1997 / 10:31:46 / cg"
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2891
!
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  2892
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2893
colorCursor:aCursorId foreground:fgColor background:bgColor
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2894
    "change a cursors colors"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2895
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2896
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2897
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2898
    |fgR fgG fgB bgR bgG bgB|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2899
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2900
    fgR := fgColor scaledRed.
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2901
    fgG := fgColor scaledGreen.
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2902
    fgB := fgColor scaledBlue.
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2903
    bgR := bgColor scaledRed.
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2904
    bgG := bgColor scaledGreen.
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2905
    bgB := bgColor scaledBlue.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2906
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2907
    XColor fgcolor, bgcolor;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2908
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2909
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  2910
     && __isExternalAddress(aCursorId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2911
     && __bothSmallInteger(fgG, fgB)
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2912
     && __bothSmallInteger(bgR, bgG)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2913
     && __bothSmallInteger(bgB, fgR)) {
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2914
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2915
        fgcolor.red = __intVal(fgR);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2916
        fgcolor.green= __intVal(fgG);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2917
        fgcolor.blue = __intVal(fgB);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2918
        bgcolor.red = __intVal(bgR);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2919
        bgcolor.green= __intVal(bgG);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2920
        bgcolor.blue = __intVal(bgB);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2921
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2922
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2923
        XRecolorCursor(myDpy, __CursorVal(aCursorId), &fgcolor, &bgcolor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2924
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2925
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2926
        RETURN ( self );
72
3e84121988c3 *** empty log message ***
claus
parents: 70
diff changeset
  2927
    }
834
f71ba674da2a Color changed to use integer r/g/b components internally (0..16rFFFF)
Claus Gittinger <cg@exept.de>
parents: 830
diff changeset
  2928
%}.
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2929
    self primitiveFailedOrClosedConnection
70
3cb3992ead10 *** empty log message ***
claus
parents: 66
diff changeset
  2930
!
3cb3992ead10 *** empty log message ***
claus
parents: 66
diff changeset
  2931
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2932
createCursorShape:aShape
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2933
    "create a cursor given a shape-symbol. This only works
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2934
     for a few standard cursors, and returns nil if no such cursor exists.
1838
040e4689dfcd oops - do not return self from failing primCreateBitmap
Claus Gittinger <cg@exept.de>
parents: 1835
diff changeset
  2935
     Senders must always care for a fallBack, in case of a nil return."
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2936
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2937
    |shapeNumber|
3226
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2938
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2939
    shapeNumber := self shapeNumberFromSymbol:aShape.
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2940
    shapeNumber isNil ifTrue:[^ nil].
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2941
    ^ self primCreateCursorShapeNumber:shapeNumber
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2942
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2943
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2944
createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy width:w height:h
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2945
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2946
3227
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  2947
    ^ self
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2948
        primCreateCursorSourceFormId:sourceForm id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2949
        maskFormId:maskForm id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2950
        hotX:hx hotY:hy
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2951
        width:w height:h
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2952
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2953
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2954
destroyCursor:aCursorId
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2955
    "release a cursor - frees any device resources"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2956
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2957
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2958
%{
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2959
    /*
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2960
     * ignore closed connection
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2961
     */
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2962
    if (! ISCONNECTED) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2963
        RETURN ( self );
1211
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2964
    }
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2965
06d63d128bde allow destroy & free methods to be called even if unconnected
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
  2966
    if (__isExternalAddress(aCursorId)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2967
        Cursor curs = __CursorVal(aCursorId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2968
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2969
        if (curs) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2970
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2971
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2972
            XFreeCursor(myDpy, curs);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2973
            LEAVE_XLIB();
923
64bbcd3ee100 added debug counting of X resource allocation
Claus Gittinger <cg@exept.de>
parents: 918
diff changeset
  2974
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2975
            __cnt_cursor--;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2976
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2977
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2978
        RETURN ( self );
4292
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2979
    }
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2980
%}.
153fc6f79fff Do not signal closedConnection in methods where a closed connection is ignored.
Stefan Vogel <sv@exept.de>
parents: 4286
diff changeset
  2981
    self primitiveFailed
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2982
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  2983
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2984
needDeviceFormsForCursor
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2985
    ^ true
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2986
!
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  2987
3226
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2988
primCreateCursorShapeNumber:aShapeNumber
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2989
    "create a cursor given a shape-number."
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2990
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  2991
    <context: #return>
3226
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2992
%{
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2993
    Cursor newCursor;
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2994
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2995
    if (ISCONNECTED
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2996
     && __isSmallInteger(aShapeNumber)) {
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  2997
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2998
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  2999
        newCursor = XCreateFontCursor(myDpy, __intVal(aShapeNumber));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3000
        LEAVE_XLIB();
3226
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  3001
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3002
        if (newCursor)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3003
            __cnt_cursor++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3004
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3005
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3006
        if (newCursor != (Cursor)0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3007
            RETURN (__MKEXTERNALADDRESS(newCursor));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3008
        }
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3009
    }
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3010
%}.
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3011
    self primitiveFailedOrClosedConnection.
3226
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  3012
    ^ nil
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  3013
!
e01fe43e24f0 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3225
diff changeset
  3014
3227
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3015
primCreateCursorSourceFormId:sourceId maskFormId:maskId hotX:hx hotY:hy width:w height:h
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3016
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3017
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3018
    <context: #return>
3227
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3019
%{
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3020
    Cursor newCursor;
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3021
    XColor fgColor, bgColor;
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3022
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3023
    if (ISCONNECTED
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3024
     && __isExternalAddress(sourceId)
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3025
     && __isExternalAddress(maskId)
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3026
     && __bothSmallInteger(hx, hy)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3027
        fgColor.red = 0;        /* fg is black */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3028
        fgColor.green = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3029
        fgColor.blue = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3030
        bgColor.red = 0xFFFF;   /* bg is white */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3031
        bgColor.green = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3032
        bgColor.blue = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3033
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3034
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3035
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3036
        newCursor = XCreatePixmapCursor(myDpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3037
                                __PixmapVal(sourceId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3038
                                __PixmapVal(maskId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3039
                                &fgColor, &bgColor, __intVal(hx), __intVal(hy));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3040
        LEAVE_XLIB();
3227
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3041
#ifdef COUNT_RESOURCES
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3042
        if (newCursor)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3043
            __cnt_cursor++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3044
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3045
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3046
        if (newCursor != (Cursor)0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3047
            RETURN (__MKEXTERNALADDRESS(newCursor));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3048
        }
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3049
    }
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3050
%}.
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3051
    self primitiveFailedOrClosedConnection.
3227
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3052
    ^ nil
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3053
!
c3a036f3df05 rel5 migration
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
  3054
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3055
shapeNumberFromSymbol:shape
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  3056
    "given a shape-symbol, return the corresponding cursor-number,
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  3057
     or nil if no such standard cursor exists."
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3058
1563
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  3059
    "/this is pure X-knowlegde - but you may easily add more
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  3060
    "/ if you add something here, also add to #builtInCursorShapes ...
5a634cfaffad allow device to specify its builtIn cursors
Claus Gittinger <cg@exept.de>
parents: 1558
diff changeset
  3061
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3062
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3063
    (shape == #upLeftArrow)     ifTrue:[ ^ %{ __MKSMALLINT(XC_top_left_arrow)    %} "132" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3064
    (shape == #upRightHand)     ifTrue:[ ^ %{ __MKSMALLINT(XC_hand1)             %} "58" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3065
    (shape == #upDownArrow)     ifTrue:[ ^ %{ __MKSMALLINT(XC_sb_v_double_arrow) %} "116" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3066
    (shape == #leftRightArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_sb_h_double_arrow) %} "108" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3067
    (shape == #upLimitArrow)    ifTrue:[ ^ %{ __MKSMALLINT(XC_top_side)          %} "138" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3068
    (shape == #downLimitArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_bottom_side)       %} "16" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3069
    (shape == #leftLimitArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_left_side)         %} "70" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3070
    (shape == #rightLimitArrow) ifTrue:[ ^ %{ __MKSMALLINT(XC_right_side)        %} "96" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3071
    (shape == #text)            ifTrue:[ ^ %{ __MKSMALLINT(XC_xterm)             %} "152" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3072
    (shape == #upRightArrow)    ifTrue:[ ^ %{ __MKSMALLINT(XC_draft_large)       %} "44" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3073
    (shape == #leftHand)        ifTrue:[ ^ %{ __MKSMALLINT(XC_hand2)             %} "60" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3074
    (shape == #questionMark)    ifTrue:[ ^ %{ __MKSMALLINT(XC_question_arrow)    %} "92" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3075
    (shape == #cross)           ifTrue:[ ^ %{ __MKSMALLINT(XC_X_cursor)          %} "0" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3076
    (shape == #wait)            ifTrue:[ ^ %{ __MKSMALLINT(XC_watch)             %} "150" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3077
    (shape == #crossHair)       ifTrue:[ ^ %{ __MKSMALLINT(XC_tcross)            %} "130" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3078
    ((shape == #origin)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3079
    or:[shape == #topLeft])     ifTrue:[ ^ %{ __MKSMALLINT(XC_ul_angle)          %} "144" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3080
    ((shape == #corner)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3081
    or:[shape == #bottomRight]) ifTrue:[ ^ %{ __MKSMALLINT(XC_lr_angle)          %} "78" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3082
    (shape == #topRight)        ifTrue:[ ^ %{ __MKSMALLINT(XC_ur_angle)          %} "148" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3083
    (shape == #bottomLeft)      ifTrue:[ ^ %{ __MKSMALLINT(XC_ll_angle)          %} "76" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3084
    (shape == #square)          ifTrue:[ ^ %{ __MKSMALLINT(XC_dotbox)            %} "40" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3085
    (shape == #fourWay)         ifTrue:[ ^ %{ __MKSMALLINT(XC_fleur)             %} "52" ].
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3086
    (shape == #crossCursor)     ifTrue:[ ^ %{ __MKSMALLINT(XC_X_cursor)          %} "0" ].
1183
28cfb8ef3504 new messages
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  3087
28cfb8ef3504 new messages
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  3088
"/    ('XWorkstation [info]: invalid cursorShape:' , shape printString) infoPrintNL.
974
12797746a1f7 WIN32 changes
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
  3089
    ^  nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3090
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3091
1543
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3092
!XWorkstation methodsFor:'drag & drop'!
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3093
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3094
dndDrop:dropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3095
    "drop something in some alien view, using the DND protocol.
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3096
     Returns false, if the drop could not be performed."
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3097
2531
e4d6bdae7bcf use quick-isString / isSymbol
Claus Gittinger <cg@exept.de>
parents: 2501
diff changeset
  3098
    |msgType dropColl dropCollSize anyFile anyDir anyText anyOther
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3099
     dropType dropTypeCode strings sz idx val|
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3100
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
  3101
    (msgType := self atomIDOf:#DndProtocol) notNil ifTrue:[
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3102
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3103
        "/ DND can drop files, file, dir, links, dirLink and text
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3104
        "/ check for this.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3105
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3106
        dropObjects isCollection ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3107
            dropColl := Array with:dropObjects
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3108
        ] ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3109
            dropColl := dropObjects
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3110
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3111
        anyFile := anyDir := anyText := anyOther := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3112
        dropColl do:[:aDropObject |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3113
            aDropObject isFileObject ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3114
                aDropObject theObject isDirectory ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3115
                    anyDir := true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3116
                ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3117
                    anyFile := true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3118
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3119
            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3120
                aDropObject isTextObject ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3121
                    anyText := true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3122
                ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3123
                    anyOther := true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3124
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3125
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3126
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3127
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3128
        anyOther ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3129
            "/ DND does not support this ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3130
            'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3131
            ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3132
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3133
        anyText ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3134
            (anyFile or:[anyDir]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3135
                "/ DND does not support mixed types
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3136
                'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3137
                ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3138
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3139
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3140
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3141
        dropCollSize := dropColl size.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3142
        anyFile ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3143
            dropType := #DndFiles.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3144
            dropCollSize == 1 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3145
                dropType := #DndFile
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3146
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3147
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3148
            anyDir ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3149
                dropType := #DndFiles.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3150
                dropCollSize == 1 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3151
                    dropType := #DndDir
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3152
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3153
            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3154
                anyText ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3155
                    dropCollSize == 1 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3156
                        dropType := #DndText
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3157
                    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3158
                        "/ can only drop a single text object
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3159
                        'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3160
                        ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3161
                    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3162
                ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3163
                    "/ mhmh ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3164
                    'XWorkstation [info]: DND cannot drop this' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3165
                    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3166
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3167
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3168
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3169
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3170
        dropTypeCode := self dndDropTypes indexOf:dropType.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3171
        dropTypeCode == 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3172
            'XWorkstation [info]: DND cannot drop this' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3173
            ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3174
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3175
        dropTypeCode := dropTypeCode - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3176
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3177
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3178
        "/ place the selection inTo the DndSelection property
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3179
        "/ of the rootView ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3180
        "/ ... need a single string, with 0-terminated parts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3181
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3182
        strings := OrderedCollection new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3183
        sz := 0.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3184
        dropColl do:[:anObject |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3185
            |s o|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3186
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3187
            o := anObject theObject.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3188
            anObject isFileObject ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3189
                o := o pathName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3190
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3191
            s := o asString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3192
            strings add:s.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3193
            sz := sz + (s size) + 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3194
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3195
        val := String new:sz.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3196
        idx := 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3197
        strings do:[:aString |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3198
            |sz|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3199
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3200
            sz := aString size.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3201
            val replaceFrom:idx to:(idx + sz - 1) with:aString startingAt:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3202
            idx := idx + sz.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3203
            val at:idx put:(Character value:0).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3204
            idx := idx + 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3205
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3206
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3207
        self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3208
            setProperty:(self atomIDOf:#DndSelection)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3209
            type:(self atomIDOf:#STRING)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3210
            value:val
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3211
            for:rootId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3212
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3213
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3214
            sendClientEvent:msgType
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3215
            format:32
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3216
            to:destinationId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3217
            propagate:true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3218
            eventMask:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3219
            window:destinationId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3220
            data1:dropTypeCode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3221
            data2:0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3222
            data3:destinationId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3223
            data4:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3224
            data5:nil.
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3225
    ].
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3226
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3227
    ^ false
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3228
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3229
    "Created: 6.4.1997 / 13:39:37 / cg"
1558
e1eb73ed3360 support all DND dropTypes.
Claus Gittinger <cg@exept.de>
parents: 1557
diff changeset
  3230
    "Modified: 6.4.1997 / 14:30:43 / cg"
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3231
!
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3232
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3233
dndDropTypes
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3234
    "return the dropTypes as supported by DND"
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3235
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3236
    ^ #(
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3237
            DndUnknown      "/ 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3238
            DndRawData      "/ 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3239
            DndFile         "/ 2
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3240
            DndFiles        "/ 3
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3241
            DndText         "/ 4
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3242
            DndDir          "/ 5
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3243
            DndLink         "/ 6
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3244
            DndExe          "/ 7
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3245
       )
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3246
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3247
    "Created: 6.4.1997 / 12:57:56 / cg"
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3248
    "Modified: 6.4.1997 / 13:38:52 / cg"
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3249
!
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3250
1583
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
  3251
drop:aCollectionOfDropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3252
    "drop something in some alien view.
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3253
     Returns false, if the drop could not be performed."
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3254
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3255
    "/
1543
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3256
    "/ see, if the display supports the DND protocol ...
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3257
    "/
3320
20c37636e4b8 Fixes for newDisplatchLastEvent.
Stefan Vogel <sv@exept.de>
parents: 3319
diff changeset
  3258
    (self atomIDOf:#DndProtocol) notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3259
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3260
            dndDrop:aCollectionOfDropObjects
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3261
            inWindowID:destinationId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3262
            position:destinationPoint
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3263
            rootPosition:rootPoint
1543
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3264
    ].
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3265
1556
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3266
    "/ add more drag&drop protocols here.
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3267
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3268
    ^ false
cdc53ab8ceff added #sendClientEvent...
Claus Gittinger <cg@exept.de>
parents: 1554
diff changeset
  3269
1583
ca6e6732dc29 drop argument is always a collection
Claus Gittinger <cg@exept.de>
parents: 1579
diff changeset
  3270
    "Modified: 11.4.1997 / 12:44:50 / cg"
1543
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3271
! !
3887e1b2a7aa prepare drop handling;
Claus Gittinger <cg@exept.de>
parents: 1540
diff changeset
  3272
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3273
!XWorkstation methodsFor:'drawing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3274
1030
ca9d23090688 pass srcGCId to bit-blitters (req'd on WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  3275
copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3276
    "do a bit-blt; copy bits from the rectangle defined by
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3277
     srcX/srcY and w/h from the sourceId drawable to the rectangle
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3278
     below dstX/dstY in the destId drawable. Trigger an error if any
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3279
     argument is not integer."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3280
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3281
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3282
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3283
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3284
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3285
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3286
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3287
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3288
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3289
    ].
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3290
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3291
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3292
    GC gc;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3293
    Drawable source, dest;
48194c26a46c Initial revision
claus
parents:
diff changeset
  3294
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3295
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3296
     && __isExternalAddress(dstGCId)
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  3297
     && __isExternalAddress(sourceId)
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  3298
     && __isExternalAddress(destId)
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3299
     && __bothSmallInteger(w, h)
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3300
     && __bothSmallInteger(srcX, srcY)
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3301
     && __bothSmallInteger(dstX, dstY)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3302
        int _sX, _sY, _w, _h, _dX, _dY;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3303
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3304
        _sX = __intVal(srcX);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3305
        _sY = __intVal(srcY);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3306
        _w = __intVal(w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3307
        _h = __intVal(h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3308
        _dX = __intVal(dstX);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3309
        _dY = __intVal(dstY);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3310
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3311
        gc = __GCVal(dstGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3312
        source = __DrawableVal(sourceId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3313
        dest =   __DrawableVal(destId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3314
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3315
        XCopyArea(myDpy, source, dest, gc, _sX, _sY, _w, _h, _dX, _dY);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3316
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3317
        RETURN ( self );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3318
    }
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3319
%}.
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3320
    "badGC, bad sourceDrawableId or destDrawableID
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3321
     or any non integer coordinate"
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3322
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3323
    self primitiveFailedOrClosedConnection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3324
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3325
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3326
copyFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3327
    "do a bit-blt from a pix- or bitmap; copy bits from the rectangle defined by
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3328
     srcX/srcY and w/h from the sourceId drawable to the rectangle
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3329
     below dstX/dstY in the destId drawable. Trigger an error if any
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3330
     argument is not integer.
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3331
     This is basically the same as copyFromId:..., but does not generate expose events."
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3332
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3333
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3334
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3335
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3336
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3337
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3338
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3339
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3340
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3341
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3342
%{
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3343
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3344
    GC gc;
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3345
    Drawable source, dest;
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3346
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3347
    if (ISCONNECTED
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3348
     && __isExternalAddress(dstGCId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3349
     && __isExternalAddress(sourceId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3350
     && __isExternalAddress(destId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3351
     && __bothSmallInteger(w, h)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3352
     && __bothSmallInteger(srcX, srcY)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3353
     && __bothSmallInteger(dstX, dstY)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3354
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3355
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3356
        gc = __GCVal(dstGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3357
        source = __DrawableVal(sourceId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3358
        dest =   __DrawableVal(destId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3359
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3360
        XSetGraphicsExposures(dpy, gc, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3361
        XCopyArea(dpy, source, dest, gc,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3362
                                __intVal(srcX), __intVal(srcY),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3363
                                __intVal(w), __intVal(h),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3364
                                __intVal(dstX), __intVal(dstY));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3365
        XSetGraphicsExposures(dpy, gc, 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3366
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3367
        RETURN ( self );
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3368
    }
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3369
%}.
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3370
    "badGC, bad sourceDrawableId or destDrawableID
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3371
     or any non integer coordinate"
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3372
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3373
    self primitiveFailedOrClosedConnection
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3374
!
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3375
1030
ca9d23090688 pass srcGCId to bit-blitters (req'd on WINDOWS)
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  3376
copyPlaneFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3377
    "do a bit-blt, but only copy the low-bit plane;
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3378
     copy bits from the rectangle defined by
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3379
     srcX/srcY and w/h from the sourceId drawable to the rectangle
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3380
     below dstX/dstY in the destId drawable. Trigger an error if any
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3381
     argument is not integer."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3382
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3383
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3384
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3385
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3386
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3387
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3388
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3389
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3390
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3391
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3392
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3393
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3394
    GC gc;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3395
    Drawable source, dest;
48194c26a46c Initial revision
claus
parents:
diff changeset
  3396
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3397
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3398
     && __isExternalAddress(dstGCId)
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  3399
     && __isExternalAddress(sourceId)
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  3400
     && __isExternalAddress(destId)
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3401
     && __bothSmallInteger(w, h)
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3402
     && __bothSmallInteger(srcX, srcY)
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3403
     && __bothSmallInteger(dstX, dstY)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3404
        gc = __GCVal(dstGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3405
        source = __DrawableVal(sourceId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3406
        dest =   __DrawableVal(destId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3407
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3408
        XCopyPlane(myDpy, source, dest, gc,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3409
                                 __intVal(srcX), __intVal(srcY),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3410
                                 __intVal(w), __intVal(h),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3411
                                 __intVal(dstX), __intVal(dstY), 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3412
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3413
        RETURN ( self );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3414
    }
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3415
%}.
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3416
    "badGC, bad sourceDrawableId or destDrawableID
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3417
     or any non integer coordinate"
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  3418
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3419
    self primitiveFailedOrClosedConnection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3420
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3421
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3422
copyPlaneFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3423
    "do a bit-blt from a pix- or bitmap, but only copy the low-bit plane;
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3424
     copy bits from the rectangle defined by
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3425
     srcX/srcY and w/h from the sourceId drawable to the rectangle
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3426
     below dstX/dstY in the destId drawable. Trigger an error if any
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3427
     argument is not integer.
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3428
     This is the same as copyPlaneFromId:..., but does not generate graphics exposes"
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3429
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3430
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3431
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3432
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3433
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3434
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3435
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3436
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3437
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3438
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3439
%{
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3440
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3441
    GC gc;
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3442
    Drawable source, dest;
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3443
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3444
    if (ISCONNECTED
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3445
     && __isExternalAddress(dstGCId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3446
     && __isExternalAddress(sourceId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3447
     && __isExternalAddress(destId)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3448
     && __bothSmallInteger(w, h)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3449
     && __bothSmallInteger(srcX, srcY)
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3450
     && __bothSmallInteger(dstX, dstY)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3451
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3452
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3453
        gc = __GCVal(dstGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3454
        source = __DrawableVal(sourceId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3455
        dest =   __DrawableVal(destId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3456
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3457
        XSetGraphicsExposures(dpy, gc, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3458
        XCopyPlane(dpy, source, dest, gc,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3459
                                 __intVal(srcX), __intVal(srcY),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3460
                                 __intVal(w), __intVal(h),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3461
                                 __intVal(dstX), __intVal(dstY), 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3462
        XSetGraphicsExposures(dpy, gc, 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3463
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3464
        RETURN ( self );
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3465
    }
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3466
%}.
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3467
    "badGC, bad sourceDrawableId or destDrawableID
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3468
     or any non integer coordinate"
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3469
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3470
    self primitiveFailedOrClosedConnection
1246
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3471
!
f8835fc41467 added copy*FromPixmapId:* - which do not generate graphics exposures
Claus Gittinger <cg@exept.de>
parents: 1227
diff changeset
  3472
652
30a701619098 fill/drawArc..w:h:.. renamed to ...width:height:...
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  3473
displayArcX:x y:y width:width height:height from:startAngle angle:angle in:aDrawableId with:aGCId
90
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
  3474
    "draw an arc. If any of x,y, w or h is not an integer, an error is triggered.
b1f1d7fc96eb *** empty log message ***
claus
parents: 86
diff changeset
  3475
     The angles may be floats or integer - they are given in degrees."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3476
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3477
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3478
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3479
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3480
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3481
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3482
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3483
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3484
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3485
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3486
%{
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3487
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3488
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3489
    Window win;
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3490
    int w, h, angle1, angle2;
48194c26a46c Initial revision
claus
parents:
diff changeset
  3491
    double f;
48194c26a46c Initial revision
claus
parents:
diff changeset
  3492
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3493
    if (__isSmallInteger(startAngle))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3494
        angle1 = __intVal(startAngle) * 64;
36
b297468551c6 *** empty log message ***
claus
parents: 31
diff changeset
  3495
    else if (__isFloat(startAngle)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3496
        f = __floatVal(startAngle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3497
        angle1 = f * 64;
2268
1a774fc02c83 fixed non-float (i.e. fraction) args to fillArc/ displayArc
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
  3498
    } else if (__isShortFloat(startAngle)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3499
        f = __shortFloatVal(startAngle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3500
        angle1 = f * 64;
2267
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3501
    } else goto bad;
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3502
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3503
    if (__isSmallInteger(angle))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3504
        angle2 = __intVal(angle) * 64;
36
b297468551c6 *** empty log message ***
claus
parents: 31
diff changeset
  3505
    else if (__isFloat(angle)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3506
        f = __floatVal(angle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3507
        angle2 = f * 64;
2268
1a774fc02c83 fixed non-float (i.e. fraction) args to fillArc/ displayArc
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
  3508
    } else if (__isShortFloat(angle)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3509
        f = __shortFloatVal(angle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3510
        angle2 = f * 64;
2267
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3511
    } else goto bad;
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3512
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3513
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3514
     && __isExternalAddress(aGCId)
206
4284b80bebdf changed to use ExternalAddress handles for all Window, Font,
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  3515
     && __isExternalAddress(aDrawableId)
97
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3516
     && __bothSmallInteger(x, y)
dd6116883ac0 *** empty log message ***
claus
parents: 96
diff changeset
  3517
     && __bothSmallInteger(width, height)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3518
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3519
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3520
        w = __intVal(width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3521
        h = __intVal(height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3522
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3523
         * need this check here: some servers simply dump core with bad args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3524
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3525
        if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3526
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3527
            XDrawArc(myDpy, win, gc, __intVal(x), __intVal(y),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3528
                                   w, h, angle1, angle2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3529
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3530
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3531
        RETURN ( self );
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3532
    }
2267
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3533
    bad: ;
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3534
%}.
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3535
    "badGC, badDrawable or coordinates not integer
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3536
     or angle(s) not integer or float."
f6fbc3e71521 care for float or int angles in fillArc / displayArc
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  3537
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3538
    self primitiveFailedOrClosedConnection
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3539
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3540
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3541
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3542
    "draw a line. If the coordinates are not integers, an error is triggered."
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3543
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3544
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3545
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3546
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3547
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3548
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3549
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3550
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3551
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3552
    ].
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3553
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3554
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3555
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3556
    Window win;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3557
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3558
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3559
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3560
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3561
     && __bothSmallInteger(x0, y0)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3562
     && __bothSmallInteger(x1, y1)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3563
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3564
        int ix0, iy0, ix1, iy1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3565
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3566
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3567
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3568
        ix0 = __intVal(x0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3569
        iy0 = __intVal(y0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3570
        ix1 = __intVal(x1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3571
        iy1 = __intVal(y1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3572
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3573
        /* attention: coordinates in X are shorts and wrap; clamp here. */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3574
        if (ix0 > 0x7FFF) ix0 = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3575
        else if (ix0 < -0x8000) ix0 = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3576
        if (iy0 > 0x7FFF) iy0 = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3577
        else if (iy0 < -0x8000) iy0 = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3578
        if (ix1 > 0x7FFF) ix1 = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3579
        else if (ix1 < -0x8000) ix1 = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3580
        if (iy1 > 0x7FFF) iy1 = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3581
        else if (iy1 < -0x8000) iy1 = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3582
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3583
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3584
        if ((ix0 == ix1) && (iy0 == iy1)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3585
            /* little bit shorter X-lib message (better with slow connections...) */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3586
            XDrawPoint(dpy, win, gc, ix0, iy0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3587
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3588
            XDrawLine(dpy, win, gc, ix0, iy0, ix1, iy1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3589
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3590
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3591
        RETURN ( self );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3592
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3593
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3594
    "badGC, badDrawable or coordinates not integer"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3595
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3596
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3597
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3598
displayLinesFromX:startX step:stepX yValues:yValues scaleY:scaleY transY:transY in:aDrawableId with:aGCId
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3599
    "draw a polygon starting at x; the y values derives from the collection yValues.
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3600
     The associated x is a multiple of step. Each y value will be scaled and translated
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3601
    "
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3602
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3603
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3604
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3605
    |noY|
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3606
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3607
    (noY := yValues size) < 2 ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3608
        ^ self
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3609
    ].
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3610
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3611
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3612
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3613
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3614
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3615
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3616
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3617
    ].
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3618
%{
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3619
    OBJ      yA, t;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3620
    int      i, num;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3621
    float    y, x, sY, tY, step;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3622
    GC       gc;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3623
    XPoint * points;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3624
    XPoint   qPoints[200];
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3625
    int      mustFree = 0;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3626
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3627
    Window win;
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3628
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3629
    if (ISCONNECTED
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3630
     && __isExternalAddress(aGCId)
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3631
     && __isExternalAddress(aDrawableId) ) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3632
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3633
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3634
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3635
        if( __isSmallInteger(scaleY) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3636
            sY = (float) __intVal( scaleY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3637
        else if (__isFloat(scaleY))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3638
            sY = __floatVal( scaleY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3639
        else if (__isShortFloat(scaleY))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3640
            sY = __shortFloatVal( scaleY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3641
        else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3642
            t = __SSEND0(scaleY, @symbol(asFloat), 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3643
            if (! __isFloat(t)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3644
            sY = __floatVal( t );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3645
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3646
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3647
        if( __isSmallInteger(transY) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3648
            tY = (float) __intVal( transY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3649
        else if (__isFloat(transY))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3650
            tY = __floatVal( transY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3651
        else if (__isShortFloat(transY))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3652
            tY = __shortFloatVal( transY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3653
        else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3654
            t = __SSEND0(transY, @symbol(asFloat), 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3655
            if (! __isFloat(t)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3656
            tY = __floatVal( t );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3657
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3658
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3659
        if( __isSmallInteger(startX) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3660
            x = (float) __intVal( startX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3661
        else if (__isFloat(startX))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3662
            x = __floatVal( startX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3663
        else if (__isShortFloat(startX))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3664
            x = __shortFloatVal( startX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3665
        else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3666
            t = __SSEND0(startX, @symbol(asFloat), 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3667
            if (! __isFloat(t)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3668
            x = __floatVal( t );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3669
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3670
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3671
        if( __isSmallInteger(stepX) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3672
            step = (float) __intVal( stepX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3673
        else if (__isFloat(stepX))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3674
            step = __floatVal( stepX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3675
        else if (__isShortFloat(stepX))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3676
            step = __shortFloatVal( stepX );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3677
        else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3678
            t = __SSEND0(stepX, @symbol(asFloat), 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3679
            if (! __isFloat(t)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3680
            step = __floatVal( t );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3681
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3682
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3683
        num = __intVal( noY );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3684
        if( num > 200 ) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3685
            if( ! (points = (XPoint *) malloc ( sizeof(XPoint) * num )) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3686
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3687
            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3688
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3689
            points = qPoints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3690
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3691
        for( i = 0; i < num; ++i ) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3692
            int px, py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3693
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3694
            yA  = __AT_(yValues, __MKSMALLINT(i+1) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3695
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3696
            if( __isFloat(yA) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3697
                y = __floatVal( yA );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3698
            else if( __isSmallInteger(yA) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3699
                y = (float) __intVal( yA );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3700
            else if( __isShortFloat( yA) )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3701
                y = __shortFloatVal( yA );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3702
            else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3703
                t = __SSEND0(yA, @symbol(asFloat), 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3704
                if (! __isFloat(t)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3705
                y = __floatVal( t );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3706
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3708
            px = (int) (x + 0.5);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3709
            py = (int) ((y * sY) + tY + 0.5);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3710
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3711
            /* attention: coordinates in X are shorts and wrap; clamp here. */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3712
            if (px > 0x7FFF) px = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3713
            else if (px < -0x8000) px = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3714
            if (py > 0x7FFF) py = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3715
            else if (py < -0x8000) py = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3716
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3717
            points[i].x = px;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3718
            points[i].y = py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3719
            x = x + step;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3720
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3721
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3722
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3723
        XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3724
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3725
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3726
        if( mustFree ) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3727
            free( points );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3728
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3729
        RETURN ( self );
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3730
    }
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3731
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3732
fail:
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3733
    if( mustFree )
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3734
        free( points );
3229
e83490cc4472 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3735
%}.
e83490cc4472 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3736
    ^ super displayLinesFromX:startX step:stepX yValues:yValues scaleY:scaleY transY:transY in:aDrawableId with:aGCId
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3737
2146
1c13fdc62a9f displayLinesFromX... - also handle shortFloats inline
Claus Gittinger <cg@exept.de>
parents: 2140
diff changeset
  3738
    "Modified: / 13.6.1998 / 13:51:39 / cg"
1978
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3739
!
3587bf92b94a add new method for optimization:
ca
parents: 1974
diff changeset
  3740
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3741
displayPointX:x y:y in:aDrawableId with:aGCId
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3742
    "draw a point. If x/y are not integers, an error is triggered."
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3743
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3744
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3745
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3746
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3747
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3748
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3749
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3750
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3751
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3752
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3753
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3754
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3755
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3756
    Window win;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3757
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3758
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3759
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3760
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3761
     && __bothSmallInteger(x, y)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3762
        int px, py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3763
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3764
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3765
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3766
        px = __intVal(x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3767
        py = __intVal(y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3768
        if (px > 0x7FFF) px = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3769
        else if (px < -0x8000) px = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3770
        if (py > 0x7FFF) py = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3771
        else if (py < -0x8000) py = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3772
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3773
        XDrawPoint(myDpy, win, gc, px, py);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3774
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3775
        RETURN ( self );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3776
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3777
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3778
    "badGC, badDrawable or x/y not integer"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3779
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3780
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3781
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3782
displayPolygon:aPolygon in:aDrawableId with:aGCId
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3783
    "draw a polygon, the argument aPolygon is a Collection of individual points, which
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3784
     define the polygon.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3785
     If any coordinate is not integer, an error is triggered."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3786
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3787
    <context: #return>
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3788
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3789
    |numberOfPoints newPoints|
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3790
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3791
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3792
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3793
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3794
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3795
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3796
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3797
    ].
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3798
    numberOfPoints := aPolygon size.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3799
%{
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3800
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3801
    Window win;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3802
    OBJ point, x, y;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3803
    int i, num;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3804
    XPoint *points;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3805
    XPoint qPoints[100];
377
191915daff5e *** empty log message ***
ah
parents: 374
diff changeset
  3806
    int mustFree = 0;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3807
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3808
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3809
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3810
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3811
     && __isSmallInteger(numberOfPoints)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3812
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3813
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3814
        num = __intVal(numberOfPoints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3815
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3816
         * avoid a (slow) malloc, if the number of points is small
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3817
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3818
        if (num > 100) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3819
            points = (XPoint *)malloc(sizeof(XPoint) * num);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3820
            if (! points) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3821
            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3822
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3823
            points = qPoints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3824
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3825
        for (i=0; i<num; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3826
            int px, py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3827
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3828
            point = __AT_(aPolygon, __MKSMALLINT(i+1));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3829
            if (! __isPoint(point)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3830
            x = _point_X(point);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3831
            y = _point_Y(point);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3832
            if (! __bothSmallInteger(x, y))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3833
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3834
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3835
            px = __intVal(x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3836
            py = __intVal(y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3837
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3838
            /* attention: coordinates in X are shorts and wrap; clamp here. */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3839
            if (px > 0x7FFF) px = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3840
            else if (px < -0x8000) px = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3841
            if (py > 0x7FFF) py = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3842
            else if (py < -0x8000) py = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3843
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3844
            points[i].x = px;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3845
            points[i].y = py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3846
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3847
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3848
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3849
        XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3850
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3851
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3852
        if (mustFree)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3853
            free(points);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3854
        RETURN ( self );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3855
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3856
fail: ;
377
191915daff5e *** empty log message ***
ah
parents: 374
diff changeset
  3857
    if (mustFree)
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3858
        free(points);
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3859
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3860
    "badGC, badDrawable or coordinates not integer"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3861
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3862
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3863
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3864
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3865
    "draw a rectangle. If the coordinates are not integers, an error is triggered."
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3866
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3867
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3868
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3869
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3870
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3871
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3872
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3873
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3874
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3875
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3876
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3877
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3878
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3879
    Window win;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3880
    int w, h;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3881
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3882
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3883
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3884
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3885
     && __bothSmallInteger(x, y)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3886
     && __bothSmallInteger(width, height)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3887
        int px, py;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3888
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3889
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3890
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3891
        w = __intVal(width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3892
        h = __intVal(height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3893
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3894
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3895
         * need this check here: some servers simply dump core with bad args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3896
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3897
        if ((w >= 0) && (h >= 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3898
            px = __intVal(x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3899
            py = __intVal(y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3900
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3901
            /* attention: coordinates in X are shorts and wrap; clamp here. */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3902
            if (px > 0x7FFF) px = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3903
            else if (px < -0x8000) px = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3904
            if (py > 0x7FFF) py = 0x7FFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3905
            else if (py < -0x8000) py = -0x8000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3906
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3907
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3908
            XDrawRectangle(myDpy, win, gc, px, py, w, h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3909
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3910
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3911
        RETURN ( self );
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3912
    }
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3913
%}.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3914
    "badGC, badDrawable or coordinates not integer"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3915
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3916
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3917
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3918
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3919
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3920
     foreground and background characters.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3921
     If the coordinates are not integers, an error is triggered."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3922
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  3923
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3924
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  3925
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3926
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3927
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3928
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3929
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3930
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  3931
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  3932
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3933
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3934
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  3935
    Window win;
1831
8a03aa87a0ee casts to avoid warnings
Claus Gittinger <cg@exept.de>
parents: 1813
diff changeset
  3936
    char *cp;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3937
    int  i1, i2, l, n;
486
0c35ed67797d oops - 16bit drawing was corrupted / fixed widthOf-16bit for byteSwapped displays
Claus Gittinger <cg@exept.de>
parents: 481
diff changeset
  3938
#   define NLOCALBUFFER 200
461
4a4b1384ab76 X wants 16bit strings in MSBfirst
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
  3939
    XChar2b xlatebuffer[NLOCALBUFFER];
481
62f1be5db8aa also support string-subclasses in stringDraw methods
Claus Gittinger <cg@exept.de>
parents: 480
diff changeset
  3940
    int nInstBytes;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3941
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3942
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  3943
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3944
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3945
     && __isNonNilObject(aString)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3946
     && __bothSmallInteger(index1, index2)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  3947
     && __bothSmallInteger(x, y)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3948
        int lMax = __intVal(@global(MaxStringLength));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3949
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3950
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3951
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3952
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3953
        i1 = __intVal(index1) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3954
        if (i1 >= 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3955
            OBJ cls;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3956
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3957
            i2 = __intVal(index2) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3958
            if (i2 < i1) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3959
                RETURN (self);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3960
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3961
            cp = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3962
            l = i2 - i1 + 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3963
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3964
            if (__isStringLike(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3965
                n = __stringSize(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3966
                if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3967
                    cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3968
                    if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3969
                    ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3970
                    if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3971
                        XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3972
                    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3973
                        XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3974
                    LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3975
                    RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3976
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3977
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3978
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3979
            cls = __qClass(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3980
            nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3981
            cp += nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3982
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3983
            if (__isBytes(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3984
                n = __byteArraySize(aString) - nInstBytes - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3985
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3986
                if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3987
                    cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3988
                    if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3989
                    ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3990
                    if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3991
                        XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3992
                    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3993
                        XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3994
                    LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3995
                    RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3996
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3997
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3998
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  3999
            /* TWOBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4000
            if (__isWords(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4001
                n = (__byteArraySize(aString) - nInstBytes) / 2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4002
                if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4003
                    union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4004
                        char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4005
                        unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4006
                    } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4007
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4008
                    XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4009
                    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4010
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4011
                    cp += (i1 * 2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4012
                    if (l > lMax) l = lMax;
3990
5d9342503bf6 font stuff
Claus Gittinger <cg@exept.de>
parents: 3988
diff changeset
  4013
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4014
#if defined(MSBFIRST) || defined(__MSBFIRST)
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4015
                    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4016
                     * chars already in correct order
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4017
                     */
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4018
#else
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4019
# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4020
                    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4021
                     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4022
                     * X expects them MSB first
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4023
                     * convert as required
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4024
                     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4025
                    u.s = 0x1234;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4026
                    if (u.b[0] != 0x12)
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4027
# endif
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4028
                    {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4029
                        if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4030
                            cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4031
                        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4032
                            cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4033
                            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4034
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4035
                        for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4036
                            cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4037
                            cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4038
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4039
                        cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4040
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4041
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4042
                    ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4043
                    if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4044
                        XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4045
                    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4046
                        XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4047
                    LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4048
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4049
                    if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4050
                        free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4051
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4052
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4053
                    RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4054
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4055
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4056
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4057
            /* FOURBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4058
            if (__isLongs(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4059
                n = (__byteArraySize(aString) - nInstBytes) / 4;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4060
                if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4061
                    union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4062
                        char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4063
                        unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4064
                    } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4065
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4066
                    XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4067
                    int32 *ip;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4068
                    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4069
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4070
                    cp += (i1 * 4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4071
                    if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4072
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4073
                    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4074
                     * all codePoints <= 16rFFFF are draw; above 16bit range are drawn as 16rFFFF.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4075
                     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4076
                    if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4077
                        cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4078
                    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4079
                        cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4080
                        mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4081
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4082
                    for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4083
                        int32 codePoint = ((int32 *)cp)[i];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4084
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4085
                        if (codePoint > 0xFFFF) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4086
                            codePoint = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4087
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4088
                        cp2[i].byte1 = (codePoint >> 8) & 0xFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4089
                        cp2[i].byte2 = codePoint & 0xFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4090
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4091
                    cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4092
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4093
                    ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4094
                    if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4095
                        XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4096
                    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4097
                        XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4098
                    LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4099
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4100
                    if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4101
                        free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4102
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4103
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4104
                    RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4105
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4106
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4107
        }
486
0c35ed67797d oops - 16bit drawing was corrupted / fixed widthOf-16bit for byteSwapped displays
Claus Gittinger <cg@exept.de>
parents: 481
diff changeset
  4108
    }
481
62f1be5db8aa also support string-subclasses in stringDraw methods
Claus Gittinger <cg@exept.de>
parents: 480
diff changeset
  4109
#undef NLOCALBUFFER
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4110
%}.
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4111
    (aString isString and:[aString bitsPerCharacter > 16]) ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4112
        self displayString:(TwoByteString new:aString size withAll:16rFFFF asCharacter)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4113
             from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4114
        ^ self.
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4115
    ].
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
  4116
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4117
    "x/y not integer, badGC or drawable, or not a string"
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  4118
    self primitiveFailedOrClosedConnection
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4119
!
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4120
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  4121
displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4122
    "draw a string - if opaque is false, draw foreground only; otherwise, draw both
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4123
     foreground and background characters.
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4124
     If the coordinates are not integers, an error is triggered."
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4125
3303
8a2e99ebccb3 primitiveFailed vs. primitiveFailedOrClosedConnection
Claus Gittinger <cg@exept.de>
parents: 3287
diff changeset
  4126
    <context: #return>
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  4127
6153
19d2ead1d7ae class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6152
diff changeset
  4128
    operationsUntilFlush notNil ifTrue:[
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4129
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4130
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4131
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4132
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4133
        ].
6152
1933a8c5de56 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6131
diff changeset
  4134
    ].
4245
d28b613dfc06 timeout handling changed
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  4135
%{
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4136
303
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  4137
    GC gc;
f2021d90f12d dont access GC's Windows before checking them for being ExternalBytes instances
Claus Gittinger <cg@exept.de>
parents: 295
diff changeset
  4138
    Window win;
1831
8a03aa87a0ee casts to avoid warnings
Claus Gittinger <cg@exept.de>
parents: 1813
diff changeset
  4139
    char *cp;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4140
    int n;
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4141
    OBJ cls;
486
0c35ed67797d oops - 16bit drawing was corrupted / fixed widthOf-16bit for byteSwapped displays
Claus Gittinger <cg@exept.de>
parents: 481
diff changeset
  4142
#   define NLOCALBUFFER 200
461
4a4b1384ab76 X wants 16bit strings in MSBfirst
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
  4143
    XChar2b xlatebuffer[NLOCALBUFFER];
481
62f1be5db8aa also support string-subclasses in stringDraw methods
Claus Gittinger <cg@exept.de>
parents: 480
diff changeset
  4144
    int nInstBytes;
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4145
1209
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  4146
    if (ISCONNECTED
98d9f8a5a2a6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1207
diff changeset
  4147
     && __isExternalAddress(aGCId)
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4148
     && __isExternalAddress(aDrawableId)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4149
     && __isNonNilObject(aString)
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  4150
     && __bothSmallInteger(x, y)) {
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4151
        int lMax = __intVal(@global(MaxStringLength));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4152
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4153
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4154
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4155
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4156
        cp = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4157
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4158
        if (__isStringLike(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4159
            n = __stringSize(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4160
            if (n > lMax) n = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4161
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4162
            if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4163
                XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4164
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4165
                XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4166
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4167
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4168
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4169
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4170
        cls = __qClass(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4171
        nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4172
        cp += nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4173
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4174
        if (__isBytes(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4175
            n = __byteArraySize(aString) - nInstBytes - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4176
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4177
            if (n > lMax) n = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4178
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4179
            if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4180
                XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4181
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4182
                XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4183
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4184
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4185
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4186
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4187
        /* TWOBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4188
        if (__isWords(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4189
            union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4190
                char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4191
                unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4192
            } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4193
            int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4194
            XChar2b *cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4195
            int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4196
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4197
            n = (__byteArraySize(aString) - nInstBytes) / 2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4198
            if (n > lMax) n = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4199
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4200
#if defined(MSBFIRST) || defined(__MSBFIRST)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4201
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4202
             * chars already in correct order
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4203
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4204
#else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4205
# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4206
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4207
             * ST/X TwoByteStrings store the asciiValue in native byteOrder;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4208
             * X expects them MSB first
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4209
             * convert as required
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4210
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4211
            u.s = 0x1234;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4212
            if (u.b[0] != 0x12)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4213
# endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4214
            {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4215
                if (n <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4216
                    cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4217
                } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4218
                    cp2 = (XChar2b *)(malloc(n * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4219
                    mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4220
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4221
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4222
                for (i=0; i<n; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4223
                    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4224
                    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4225
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4226
                cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4227
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4228
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4229
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4230
            if (opaque == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4231
                XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4232
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4233
                XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4234
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4235
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4236
            if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4237
                free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4238
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4239
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4240
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4241
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4242
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4243
#undef NLOCALBUFFER
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4244
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4245
    ^ super displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4246
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4247
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4248
drawBits:givenBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:givenPadding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4249
        width:imageWidth height:imageHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4250
        x:srcx y:srcy
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4251
        into:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4252
        x:dstx y:dsty
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4253
        width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4254
        with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4255
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4256
    "draw a bitImage which has depth id, width iw and height ih into
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4257
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4258
     Individual source pixels have bitsPerPixel bits, allowing to draw
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4259
     depth and pixel-units to be different.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4260
     It has to be checked elsewhere, that the server can do it with the given
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4261
     depth - otherwise, primitive failure will be signalled.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4262
     Also it is assumed, that the colormap is setup correctly and the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4263
     colors are allocated - otherwise the colors may be wrong."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4264
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4265
    |fmt padding bits wantedPadding|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4266
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4267
    padding := givenPadding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4268
    bits := givenBits.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4269
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4270
    "/ the XF86_VGA16 server seems to report an error when we pass it an
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4271
    "/ 8-bit padded image. (it wants it 32bit padded).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4272
    "/ as a workaround, repad it here (although, the server and/or Xlib should
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4273
    "/ care for that.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4274
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4275
    ((imageDepth == 4) and:[depth == 4]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4276
        fmt := self supportedImageFormatForDepth:4.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4277
        fmt isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4278
            self primitiveFailed. "/ cannot represent this image
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4279
            ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4280
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4281
        wantedPadding := fmt at:#padding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4282
        wantedPadding > givenPadding ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4283
            bits := self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4284
                            repadBits:givenBits
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4285
                            width:imageWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4286
                            height:imageHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4287
                            depth:imageDepth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4288
                            from:givenPadding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4289
                            to:wantedPadding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4290
            padding := wantedPadding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4291
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4292
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4293
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4294
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4295
    operationsUntilFlush notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4296
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4297
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4298
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4299
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4300
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4301
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4302
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4303
     sorry; I had to separate it into 2 methods, since XPutImage needs
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4304
     an unlimited stack, and thus cannot send primitiveFailed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4305
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4306
    (self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4307
        primDrawBits:bits
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4308
        bitsPerPixel:bitsPerPixel
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4309
        depth:imageDepth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4310
        msb:true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4311
        padding:padding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4312
        width:imageWidth height:imageHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4313
        x:srcx y:srcy
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4314
        into:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4315
        x:dstx y:dsty
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4316
        width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4317
        with:aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4318
    ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4319
        "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4320
         also happens, if a segmentation violation occurs in the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4321
         XPutImage ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4322
        "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4323
        self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4324
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4325
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4326
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4327
fillArcX:x y:y width:width height:height from:startAngle angle:angle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4328
               in:aDrawableId with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4329
    "fill an arc. If any coordinate is not integer, an error is triggered.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4330
     The angles may be floats or integer - they are given in degrees."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4331
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4332
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4333
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4334
    operationsUntilFlush notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4335
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4336
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4337
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4338
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4339
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4340
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4341
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4342
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4343
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4344
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4345
    int w, h, angle1, angle2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4346
    double f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4347
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4348
    if (__isSmallInteger(startAngle))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4349
        angle1 = __intVal(startAngle) * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4350
    else if (__isFloat(startAngle)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4351
        f = __floatVal(startAngle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4352
        angle1 = f * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4353
    } else if (__isShortFloat(startAngle)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4354
        f = __shortFloatVal(startAngle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4355
        angle1 = f * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4356
    } else goto bad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4357
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4358
    if (__isSmallInteger(angle))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4359
        angle2 = __intVal(angle) * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4360
    else if (__isFloat(angle)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4361
        f = __floatVal(angle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4362
        angle2 = f * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4363
    } else if (__isShortFloat(angle)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4364
        f = __shortFloatVal(angle);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4365
        angle2 = f * 64;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4366
    } else goto bad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4367
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4368
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4369
     && __isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4370
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4371
     && __bothSmallInteger(x, y)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4372
     && __bothSmallInteger(width, height)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4373
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4374
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4375
        w = __intVal(width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4376
        h = __intVal(height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4377
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4378
         * need this check here: some servers simply dump core with bad args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4379
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4380
        if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4381
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4382
            XFillArc(myDpy, win, gc, __intVal(x), __intVal(y),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4383
                                   w, h, angle1, angle2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4384
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4385
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4386
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4387
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4388
    bad: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4389
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4390
    "badGC, badDrawable or coordinates not integer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4391
     or non float angle(s)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4392
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4393
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4394
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4395
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4396
fillPolygon:aPolygon in:aDrawableId with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4397
    "fill a polygon given by its points.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4398
     If any coordinate is not integer, an error is triggered."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4399
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4400
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4401
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4402
    |numberOfPoints|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4403
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4404
    operationsUntilFlush notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4405
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4406
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4407
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4408
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4409
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4410
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4411
    numberOfPoints := aPolygon size.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4412
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4413
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4414
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4415
    OBJ point, x, y;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4416
    int i, num;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4417
    XPoint *points;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4418
    XPoint qPoints[100];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4419
    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4420
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4421
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4422
     && __isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4423
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4424
     && __isSmallInteger(numberOfPoints)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4425
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4426
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4427
        num = __intVal(numberOfPoints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4428
        if (num < 3) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4429
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4430
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4431
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4432
         * avoid (slow) malloc, if not many points
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4433
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4434
        if (num > 100) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4435
            points = (XPoint *) malloc(sizeof(XPoint) * num);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4436
            if (! points) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4437
            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4438
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4439
            points = qPoints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4440
        for (i=0; i<num; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4441
            point = __AT_(aPolygon, __MKSMALLINT(i+1));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4442
            if (! __isPoint(point)) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4443
            x = _point_X(point);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4444
            y = _point_Y(point);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4445
            if (! __bothSmallInteger(x, y))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4446
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4447
            points[i].x = __intVal(x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4448
            points[i].y = __intVal(y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4449
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4450
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4451
        XFillPolygon(myDpy, win, gc, points, num, Complex, CoordModeOrigin);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4452
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4453
        if (mustFree)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4454
            free(points);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4455
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4456
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4457
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4458
        if (mustFree)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4459
            free(points);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4460
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4461
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4462
    "badGC, badDrawable or coordinates not integer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4463
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4464
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4465
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4466
fillRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4467
    "fill a rectangle. If any coordinate is not integer, an error is triggered."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4468
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4469
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4470
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4471
    operationsUntilFlush notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4472
        operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4473
            self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4474
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4475
            operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4476
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4477
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4478
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4479
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4480
    int w, h;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4481
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4482
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4483
     && __isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4484
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4485
     && __bothSmallInteger(x, y)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4486
     && __bothSmallInteger(width, height)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4487
        w = __intVal(width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4488
        h = __intVal(height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4489
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4490
         * need this check here: some servers simply dump core with bad args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4491
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4492
        if ((w >= 0) && (h >= 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4493
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4494
            XFillRectangle(myDpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4495
                           __DrawableVal(aDrawableId), __GCVal(aGCId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4496
                           __intVal(x), __intVal(y), w, h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4497
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4498
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4499
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4500
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4501
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4502
    "badGC, badDrawable or coordinates not integer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4503
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4504
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4505
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4506
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb masks:maskArray padding:bitPadding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4507
                             extent:imageExtent sourceOrigin:srcOrg
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4508
                               into:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4509
                  destinationOrigin:dstOrg extent:dstExtent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4510
                               with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4511
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4512
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4513
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4514
    |imageWidth imageHeight rm gm bm srcx srcy dstx dsty w h|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4515
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4516
    imageWidth := imageExtent x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4517
    imageHeight := imageExtent y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4518
    rm := maskArray at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4519
    gm := maskArray at:2.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4520
    bm := maskArray at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4521
    srcx := srcOrg x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4522
    srcy := srcOrg y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4523
    dstx := dstOrg x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4524
    dsty := dstOrg y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4525
    w := dstExtent x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4526
    h := dstExtent y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4527
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4528
    "since XPutImage may allocate huge amount of stack space
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4529
     (some implementations use alloca), this must run with unlimited stack."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4530
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4531
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4532
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4533
    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4534
     * need unlimited stack, since some Xlibs do a huge alloca in
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4535
     * XPutImage
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4536
     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4537
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4538
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4539
    XImage image;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4540
    int imgWdth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4541
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4542
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4543
     && __isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4544
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4545
     && __bothSmallInteger(srcx, srcy)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4546
     && __bothSmallInteger(dstx, dsty)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4547
     && __bothSmallInteger(w, h)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4548
     && __bothSmallInteger(imageWidth, imageHeight)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4549
     && __bothSmallInteger(imageDepth, bitsPerPixel)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4550
     && __isSmallInteger(bitPadding)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4551
     && __bothSmallInteger(rm, gm)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4552
     && __isSmallInteger(bm)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4553
     && __isByteArrayLike(imageBits)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4554
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4555
        int pad = __intVal(bitPadding);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4556
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4557
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4558
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4559
        if (! gc || !win)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4560
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4561
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4562
        console_printf("args ok\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4563
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4564
        image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4565
        image.width = imgWdth = __intVal(imageWidth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4566
        image.height = __intVal(imageHeight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4567
        image.xoffset = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4568
        image.format = ZPixmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4569
        image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4570
        image.bitmap_unit = 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4571
        image.bitmap_bit_order = MSBFirst;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4572
        image.bitmap_pad = pad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4573
        image.depth = __intVal(imageDepth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4574
        image.bits_per_pixel = __intVal(bitsPerPixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4575
        image.red_mask = __intVal(rm);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4576
        image.green_mask = __intVal(gm);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4577
        image.blue_mask = __intVal(bm);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4578
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4579
        image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4580
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4581
        switch (image.bits_per_pixel) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4582
            case 1:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4583
            case 2:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4584
            case 4:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4585
            case 8:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4586
            case 16:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4587
            case 24:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4588
            case 32:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4589
                break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4590
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4591
            default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4592
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4593
                console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4594
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4595
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4596
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4597
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4598
        /* ENTER_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4599
        XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4600
                                        __intVal(dstx), __intVal(dsty),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4601
                                        __intVal(w), __intVal(h));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4602
        /* LEAVE_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4603
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4604
        RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4605
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4606
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4607
    if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4608
    if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4609
    if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4610
    if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4611
    if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4612
    if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4613
    if (!! __isSmallInteger(w)) console_printf("w\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4614
    if (!! __isSmallInteger(h)) console_printf("h\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4615
    if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4616
    if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4617
    if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4618
    if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4619
    if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4620
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4621
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4622
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4623
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4624
.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4625
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4626
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4627
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4628
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb padding:bitPadding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4629
                              width:imageWidth height:imageHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4630
                                  x:srcx y:srcy
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4631
                               into:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4632
                                  x:dstx y:dsty
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4633
                              width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4634
                               with:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4635
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4636
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4637
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4638
    "since XPutImage may allocate huge amount of stack space
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4639
     (some implementations use alloca), this must run with unlimited stack."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4640
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4641
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4642
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4643
    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4644
     * need unlimited stack, since some Xlibs do a huge alloca in
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4645
     * XPutImage
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4646
     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4647
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4648
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4649
    XImage image;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4650
    int imgWdth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4651
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4652
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4653
     && __isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4654
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4655
     && __bothSmallInteger(srcx, srcy)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4656
     && __bothSmallInteger(dstx, dsty)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4657
     && __bothSmallInteger(w, h)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4658
     && __bothSmallInteger(imageWidth, imageHeight)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4659
     && __bothSmallInteger(imageDepth, bitsPerPixel)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4660
     && __isSmallInteger(bitPadding)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4661
     && __isByteArrayLike(imageBits)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4662
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4663
        int pad = __intVal(bitPadding);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4664
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4665
        gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4666
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4667
        if (! gc || !win)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4668
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4669
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4670
        console_printf("args ok\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4671
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4672
        image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4673
        image.width = imgWdth = __intVal(imageWidth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4674
        image.height = __intVal(imageHeight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4675
        image.xoffset = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4676
        image.format = ZPixmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4677
        image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4678
        image.bitmap_unit = 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4679
        image.bitmap_bit_order = MSBFirst;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4680
        image.bitmap_pad = pad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4681
        image.depth = __intVal(imageDepth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4682
        image.bits_per_pixel = __intVal(bitsPerPixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4683
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4684
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4685
        image.bytes_per_line = ((((imgWdth * image.depth) + (pad-1)) / pad) * pad) / 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4686
        */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4687
        image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4688
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4689
        switch (image.bits_per_pixel) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4690
            case 1:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4691
            case 2:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4692
            case 4:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4693
            case 8:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4694
            case 16:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4695
            case 24:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4696
            case 32:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4697
                break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4698
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4699
            default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4700
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4701
                console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4702
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4703
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4704
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4705
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4706
        image.red_mask = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4707
        image.green_mask = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4708
        image.blue_mask = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4709
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4710
        /* ENTER_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4711
        XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4712
                                        __intVal(dstx), __intVal(dsty),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4713
                                        __intVal(w), __intVal(h));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4714
        /* LEAVE_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4715
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4716
        RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4717
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4718
#ifdef ARGDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4719
    if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4720
    if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4721
    if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4722
    if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4723
    if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4724
    if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4725
    if (!! __isSmallInteger(w)) console_printf("w\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4726
    if (!! __isSmallInteger(h)) console_printf("h\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4727
    if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4728
    if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4729
    if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4730
    if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4731
    if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4732
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4733
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4734
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4735
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4736
.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4737
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4738
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4739
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4740
!XWorkstation methodsFor:'event forwarding'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4741
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4742
buttonMotion:view state:state x:x y:y rootX:rX rootY:rY time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4743
    "forward a buttonMotion event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4744
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4745
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4746
    self buttonMotion:state x:x y:y view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4747
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4748
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4749
buttonPress:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4750
    "forward a buttonPress event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4751
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4752
    |logicalButton|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4753
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4754
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4755
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4756
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4757
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4758
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4759
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4760
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4761
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4762
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4763
    "/ physical to logical button translation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4764
    logicalButton := buttonTranslation at:button ifAbsent:button.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4765
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4766
    "/ special for mouse-wheel implementation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4767
    (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4768
      self mouseWheelMotion:state x:x y:y amount:(logicalButton == #wheelFwd ifTrue:[10] ifFalse:[-10]) deltaTime:10 view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4769
      ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4770
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4771
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4772
    logicalButton isInteger ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4773
        buttonsPressed := buttonsPressed bitOr:(1 bitShift:logicalButton-1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4774
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4775
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4776
    (multiClickTimeDelta notNil and:[lastButtonPressTime notNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4777
        time < (lastButtonPressTime + multiClickTimeDelta) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4778
            lastButtonPressTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4779
            self buttonMultiPress:logicalButton x:x y:y view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4780
            ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4781
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4782
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4783
    lastButtonPressTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4784
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4785
    view isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4786
        "/ event arrived, after I destroyed it myself
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4787
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4788
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4789
    logicalButton == 1 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4790
        activateOnClick == true ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4791
            "/ dont raise above an active popup view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4792
            (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4793
                view topView raise.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4794
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4795
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4796
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4797
    super buttonPress:logicalButton x:x y:y view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4798
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4799
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4800
buttonRelease:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4801
    "forward a buttonPress event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4802
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4803
    |logicalButton|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4804
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4805
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4806
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4807
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4808
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4809
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4810
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4811
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4812
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4813
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4814
    "/ physical to logical button translation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4815
    logicalButton := buttonTranslation at:button ifAbsent:button.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4816
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4817
    "/ special for HPs mouse-wheel implementation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4818
    (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4819
      ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4820
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4821
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4822
    logicalButton isInteger ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4823
        buttonsPressed := buttonsPressed bitClear:(1 bitShift:logicalButton-1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4824
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4825
    self buttonRelease:logicalButton x:x y:y view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4826
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4827
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4828
clientMessage:targetView type:typeAtom format:format data:data
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4829
    |sensor|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4830
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4831
    targetView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4832
        "targetView is gone? Anyway, cannot do anything with this event..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4833
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4834
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4835
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4836
    "DND drag&drop protocol"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4837
    (format == 32 and:[typeAtom == (self atomIDOf:#DndProtocol)]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4838
        self dndMessage:nil data:data view:targetView.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4839
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4840
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4841
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4842
    sensor := targetView sensor.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4843
    "not posted, if there is no sensor ..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4844
    sensor notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4845
        sensor clientMessage:typeAtom format:format eventData:data view:targetView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4846
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4847
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4848
    "Created: 4.4.1997 / 17:49:26 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4849
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4850
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4851
configure:view relativeTo:anotherViewId x:x y:y width:w height:h borderWidth:borderWidth above:aboveViewId overrideRedirect:overrideBool
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4852
    "forward a size-change event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4853
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4854
"/    anotherViewId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4855
"/        |parentViewOrSelf|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4856
"/        parentViewOrSelf := self viewFromId:anotherViewId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4857
"/        parentViewOrSelf notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4858
"/        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4859
"/     ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4860
    self configureX:x y:y width:w height:h view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4861
    aboveViewId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4862
        |aboveView|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4863
        aboveView := self viewFromId:aboveViewId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4864
        aboveView notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4865
            "view is now on the top of the window stack"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4866
            self coveredBy:view view:aboveView.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4867
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4868
     ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4869
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4870
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4871
createWindow:view x:x y:y width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4872
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4873
    view isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4874
        "/ event arrived, after I destroyed it myself
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4875
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4876
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4877
    view sensor createWindow:view x:x y:y width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4878
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4879
    "Created: / 30-05-2011 / 16:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4880
    "Modified: / 30-05-2011 / 19:00:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4881
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4882
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4883
dndMessage:event data:data view:targetView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4884
    "handle a drag&drop protocol message"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4885
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4886
    |sensor property dropType dropValue names i1 i2 propertyType|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4887
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4888
    dropType := data doubleWordAt:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4889
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4890
    "/ see def's in DragAndDropTypes.h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4891
    dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4892
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4893
    property := self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4894
        getProperty:(self atomIDOf:#DndSelection)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4895
        from:rootId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4896
        delete:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4897
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4898
    propertyType := property key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4899
    dropValue := property value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4900
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4901
    "/ preconvert into a collection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4902
    "/ of fileNames, string or byteArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4903
    "/ Notice: we do not yet convert into dropObjects
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4904
    "/ here, to allow arbitrary data to be handled by
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4905
    "/ redefined dropMessage methods in applications.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4906
    "/ Conversion is done for some well known types
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4907
    "/ in the default dropMessage handling of SimpleView.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4908
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4909
    dropType == #DndFiles ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4910
        "/ actually, a list of fileNames
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4911
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4912
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4913
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4914
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4915
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4916
        names := OrderedCollection new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4917
        i1 := 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4918
        [i1 ~~ 0] whileTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4919
            i2 := dropValue indexOf:(Character value:0) startingAt:i1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4920
            i2 ~~ 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4921
                names add:(dropValue copyFrom:i1 to:(i2-1)).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4922
                i1 := i2 + 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4923
            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4924
                i1 := i2
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4925
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4926
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4927
        dropValue := names.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4928
        dropValue := dropValue collect:[:nm | nm asFilename].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4929
        dropType := #files.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4930
    ] ifFalse:[ (dropType == #DndFile) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4931
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4932
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4933
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4934
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4935
        dropValue := dropValue asFilename.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4936
        dropType := #file.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4937
    ] ifFalse:[ (dropType == #DndDir) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4938
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4939
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4940
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4941
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4942
        dropValue := dropValue asFilename.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4943
        dropType := #directory.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4944
    ] ifFalse:[ (dropType == #DndText) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4945
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4946
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4947
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4948
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4949
        dropType := #text.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4950
    ] ifFalse:[ (dropType == #DndExe) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4951
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4952
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4953
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4954
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4955
        dropType := #executable.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4956
    ] ifFalse:[ (dropType == #DndLink) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4957
        propertyType ~~ stringAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4958
            'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4959
            ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4960
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4961
        dropType := #link.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4962
    ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4963
        dropType := #rawData.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4964
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4965
        'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4966
        'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4967
        dropType := #unknown.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4968
    ]]]]]]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4969
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4970
    sensor := targetView sensor.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4971
    "not posted, if there is no sensor ..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4972
    sensor notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4973
        sensor dropMessage:dropType data:dropValue view:targetView position:nil handle:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4974
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4975
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4976
    "Created: 4.4.1997 / 17:59:37 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4977
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4978
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4979
expose:view x:x y:y width:w height:h count:count
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4980
    "forward an expose event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4981
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4982
    self exposeX:x y:y width:w height:h view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4983
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4984
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4985
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4986
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4987
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4988
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4989
focusIn:view mode:mode detail:detail
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4990
    "a view got the keyboard focus"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4991
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4992
    mode ~~ 1 "NotifyGrab" ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4993
        "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4994
        self focusInView:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4995
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4996
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4997
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4998
focusOut:view mode:mode detail:detail
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  4999
    "a view lost the keyboard focus"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5000
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5001
    mode ~~ 1 "NotifyGrab" ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5002
        "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5003
        self focusOutView:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5004
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5005
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5006
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5007
graphicsExpose:view x:x y:y width:w height:h count:count
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5008
    "forward a graphics-expose event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5009
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5010
    self graphicsExposeX:x y:y width:w height:h final:(count==0) view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5011
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5012
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5013
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5014
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5015
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5016
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5017
keyPress:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5018
    "forward a key-press event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5019
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5020
    |commonKey|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5021
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5022
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5023
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5024
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5025
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5026
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5027
    key isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5028
        "/ happens sometimes on some systems
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5029
        "/ (alt-graph on sun has no keysym)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5030
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5031
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5032
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5033
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5034
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5035
    "very low-level mapping of X11 event symbols to common ST/X event symbols"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5036
    commonKey := rawKeySymTranslation at:key ifAbsent:key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5037
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5038
    self keyPress:commonKey x:x y:y view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5039
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5040
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5041
keyRelease:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5042
    "forward a key-release event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5043
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5044
    |commonKey|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5045
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5046
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5047
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5048
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5049
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5050
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5051
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5052
    key isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5053
        "/ happens sometimes on some systems
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5054
        "/ (alt-graph on sun has no keysym)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5055
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5056
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5057
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5058
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5059
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5060
    "very low-level mapping of X11 event symbols to common ST/X event symbols"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5061
    commonKey := rawKeySymTranslation at:key ifAbsent:key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5062
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5063
    self keyRelease:commonKey x:x y:y view:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5064
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5065
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5066
mappingNotify:view request:what event:eB
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5067
    "One of Keyboard-, Modifier- or PointerMap has changed, probably by xmodmap.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5068
     Tell xlib about the fact."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5069
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5070
    (what == #mappingKeyboard or:[what == #mappingModifier]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5071
        self refreshKeyboardMapping:eB.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5072
        "Maybe some of our modifiers have been changed"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5073
        self initializeModifierMappings.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5074
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5075
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5076
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5077
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5078
pointerEnter:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5079
    "forward a pointer enter event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5080
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5081
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5082
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5083
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5084
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5085
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5086
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5087
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5088
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5089
    self pointerEnter:state x:x y:y view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5090
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5091
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5092
pointerLeave:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5093
    "forward a pointer leave event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5094
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5095
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5096
    altDown := state bitTest:altModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5097
    metaDown := state bitTest:metaModifierMask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5098
    shiftDown := state bitTest:(self shiftModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5099
    ctrlDown := state bitTest:(self ctrlModifierMask).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5100
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5101
    eventRootX := rX.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5102
    eventRootY := rY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5103
    self pointerLeave:state view:view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5104
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5105
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5106
propertyChange:aView property:propertyId state:aSymbol time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5107
    "sent when an X property changes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5108
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5109
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5110
    |selectionFetcher|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5111
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5112
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5113
    aView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5114
        "event arrived, after aView has been destroyed"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5115
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5116
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5117
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5118
"/    'propertyChange ' infoPrint. (self atomName:propertyId) print. ': ' print. aSymbol printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5119
"/    aView propertyChange:atom state:aSymbol.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5120
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5121
    "JV@2011-01-06: Forward this event to views, they may
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5122
     be interested (for now, only XEmbedSiteView is)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5123
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5124
    aView sensor propertyChange:aView property:propertyId state:aSymbol time:time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5125
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5126
    aSymbol ~~ #newValue ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5127
        "I am not interested in delete notifications"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5128
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5129
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5130
    selectionFetcher := self findSelectionFetcher:aView id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5131
    selectionFetcher notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5132
        selectionFetcher message:thisContext message.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5133
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5134
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5135
    "Modified: / 01-06-2011 / 13:40:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5136
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5137
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5138
selectionClear:aView selection:selectionID time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5139
    "sent when another X-client has created a selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5140
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5141
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5142
    |selectionFetcher|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5143
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5144
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5145
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5146
    selectionHandlers notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5147
        selectionHandlers do:[:eachHandler |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5148
            eachHandler selectionClear:selectionID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5149
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5150
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5151
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5152
    aView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5153
        "event arrived, after aView has been destroyed"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5154
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5155
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5156
    selectionFetcher := self findSelectionFetcher:aView id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5157
    selectionFetcher notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5158
        selectionFetcher message:thisContext message.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5159
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5160
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5161
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5162
selectionNotify:aView selection:selectionID target:targetID property:propertyID requestor:requestorID time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5163
    "This event is sent by the selection owner as a response to our request for a selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5164
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5165
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5166
    |selectionFetcher|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5167
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5168
"/    Transcript show:'seletionNotify selID:'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5169
"/    Transcript show:selectionID; show:' ('; show:(self atomName:selectionID); show:') '.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5170
"/    Transcript show:' targetID:'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5171
"/    Transcript show:targetID; show:' ('; show:(self atomName:targetID); show:') '.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5172
"/    Transcript show:' propertyID:'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5173
"/    Transcript show:propertyID; show:' ('; show:(self atomName:propertyID); show:') '.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5174
"/    Transcript showCR:''.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5175
"/    Transcript endEntry.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5176
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5177
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5178
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5179
    aView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5180
        "event arrived, after aView has been destroyed"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5181
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5182
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5183
    selectionFetcher := self findSelectionFetcher:aView id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5184
    selectionFetcher notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5185
        selectionFetcher message:thisContext message.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5186
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5187
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5188
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5189
selectionRequest:aView requestor:requestorID selection:selectionID target:targetID property:propertyID time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5190
    "sent by some other X-client to ask for the selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5191
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5192
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5193
    |selection property bufferGetSelector responseTargetID selectionTime|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5194
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5195
"/'Selection: ' print. (self atomName:selectionID) printCR. ' TargetId: ' print. (self atomName:targetID) printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5196
"/' Property: ' print. (self atomName:propertyID) printCR. ' Requestor: ' print. requestorID printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5197
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5198
    lastEventTime := time.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5199
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5200
    "JV@2012-03-27: Support both PRIMARY and CLIPBOARD selections"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5201
    selectionID == primaryAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5202
        bufferGetSelector := #getPrimaryBuffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5203
        selectionTime := primarySelectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5204
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5205
        bufferGetSelector := #getCopyBuffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5206
        selectionTime := clipboardSelectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5207
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5208
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5209
    (targetID == (self atomIDOf:#TIMESTAMP)) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5210
        "the other view wants to know when we acquired ownership of the selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5211
        responseTargetID := self atomIDOf:#INTEGER.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5212
        selection := selectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5213
    ] ifFalse:[(targetID == (self atomIDOf:#TARGETS)) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5214
        "the other view wants to know which targets we support"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5215
        responseTargetID := self atomIDOf:#ATOM.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5216
        selection := self supportedTargetAtoms.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5217
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5218
        selection := self selectionBuffer:bufferGetSelector as:targetID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5219
        responseTargetID := selection key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5220
        selection := selection value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5221
    ]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5222
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5223
"/'Send selection: ' print. selection printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5224
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5225
    property := propertyID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5226
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5227
    selection isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5228
        "sending property None tells the client,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5229
         that I could not convert"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5230
"/        ('XWorkstation: unsupported selection target ', (self atomName:targetID)) errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5231
        property := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5232
        responseTargetID := targetID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5233
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5234
        property == 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5235
            "Support old (obsolete) clients requesting a None property.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5236
             Set the propertyID to the targetID"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5237
            property := responseTargetID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5238
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5239
        self setProperty:property
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5240
             type:responseTargetID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5241
             value:selection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5242
             for:requestorID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5243
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5244
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5245
    self sendNotifySelection:selectionID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5246
         property:property
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5247
         target:responseTargetID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5248
         time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5249
         to:requestorID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5250
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5251
    "Modified: / 27-03-2012 / 15:22:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5252
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5253
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5254
visibilityNotify:aView state:how
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5255
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5256
    aView notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5257
        aView visibilityChange:how
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5258
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5259
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5260
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5261
!XWorkstation methodsFor:'event forwarding-ignored events'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5262
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5263
circulateNotify:aView place:aSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5264
    "sent, when the stacking order changes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5265
     ignored for now."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5266
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5267
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5268
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5269
circulateRequest:aView place:aSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5270
    "sent, when the stacking order is about to change.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5271
     ignored for now."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5272
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5273
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5274
colorMapNotify:aView state:aBoolean
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5275
    "sent, when another colormap is installed.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5276
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5277
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5278
    aView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5279
        "/ event arrived, after I destroyed it myself
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5280
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5281
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5282
    "/ not yet implemented
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5283
    "/ aView colorMapChange
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5284
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5285
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5286
configureRequest:view x:x y:y width:w height:h above:above detail:detail
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5287
    "ignored for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5288
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5289
    "/ view configureRequest
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5290
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5291
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5292
gravityNotify:aView x:x y:y
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5293
    "ignored for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5294
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5295
    "/ aView gravityNotify
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5296
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5297
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5298
keymapNotify:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5299
    "ignore for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5300
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5301
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5302
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5303
mapRequest:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5304
    "ignored for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5305
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5306
    "/ aView mapRequest
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5307
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5308
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5309
reparentedView:aView parentId:parentId x:x y:y
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5310
    "ignored for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5311
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5312
    "/ aView reparented
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5313
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5314
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5315
resizeRequest:aView width:width height:height
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5316
    "ignored for now"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5317
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5318
    "/ aView resizeRequest
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5319
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5320
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5321
!XWorkstation methodsFor:'event handling'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5322
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5323
defaultEventMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5324
    "return a mask to enable some events by default."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5325
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5326
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5327
    RETURN (__MKSMALLINT( ExposureMask | StructureNotifyMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5328
                         KeyPressMask | KeyReleaseMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5329
                         PointerMotionMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5330
                         EnterWindowMask | LeaveWindowMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5331
                         ButtonPressMask | ButtonMotionMask | ButtonReleaseMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5332
                         PropertyChangeMask ));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5333
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5334
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5335
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5336
dispatchEvent:evArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5337
    |viewId view evType arguments|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5338
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5339
    viewId := evArray at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5340
    viewId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5341
        viewId = lastId ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5342
            view := lastView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5343
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5344
            view := self viewFromId:viewId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5345
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5346
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5347
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5348
    evType := evArray at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5349
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5350
    (self respondsTo:evType) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5351
        arguments := evArray copyFrom:3 to:(3 + evType numArgs - 1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5352
        arguments at:1 put:view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5353
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5354
        self perform:evType withArguments:arguments.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5355
        ^ true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5356
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5357
'********** unhandled event:' errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5358
evType errorPrintCR. (evArray at:2) errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5359
'********** see dispatchEvent' errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5360
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5361
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5362
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5363
dispatchEventFor:aViewIdOrNil withMask:eventMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5364
    "central event handling method:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5365
     get next event and send appropriate message to the sensor or view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5366
     If the argument aViewIdOrNil is nil, events for any view are processed,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5367
     otherwise only events for the view with given id are processed.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5368
     If the argument aMask is nonNil, only events for this eventMask are
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5369
     handled.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5370
     WARNING: this may block to wait for an event - you better check for a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5371
              pending event before calling this."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5372
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5373
    |eventArray|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5374
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5375
    eventArray := Array new:13.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5376
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5377
    (self getEventFor:aViewIdOrNil withMask:eventMask into:eventArray) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5378
        AbortOperationRequest handle:[:ex |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5379
            ex return
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5380
        ] do:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5381
            self dispatchEvent:eventArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5382
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5383
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5384
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5385
    "Modified: 19.8.1997 / 17:10:42 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5386
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5387
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5388
dispatchExposeEventFor:aViewIdOrNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5389
    "get next expose event and send appropriate message to the sensor or view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5390
     If the argument aViewIdOrNil is nil, events for any view are processed,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5391
     otherwise only events for the view with given id are processed.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5392
     WARNING: this may block to wait for an event - you better check for a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5393
              pending event before calling this."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5394
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5395
    self dispatchEventFor:aViewIdOrNil withMask:(self eventMaskFor:#expose)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5396
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5397
    "Modified: 19.8.1997 / 17:10:26 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5398
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5399
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5400
dispatchLoop
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5401
    preWaitAction := [self flush].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5402
    Processor addPreWaitAction:preWaitAction.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5403
    [
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5404
        super dispatchLoop
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5405
    ] ensure:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5406
        Processor removePreWaitAction:preWaitAction.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5407
        preWaitAction := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5408
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5409
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5410
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5411
dispatchPendingEvents
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5412
    "central event handling method for modal operation.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5413
     (i.e. this is now only used in the modal debugger)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5414
     Dispatch any pending events; return when no more are pending.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5415
     This code is somewhat special, since X has a concept of graphic
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5416
     expose events (which are sent after a bitblt). After such a bitblt,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5417
     we only handle exposes until the graphicsExpose arrives.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5418
     Other systems may not need such a kludge"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5419
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5420
    "interested in exposes only ?"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5421
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5422
    |eventArray|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5423
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5424
    dispatchingExpose notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5425
        [self exposeEventPendingFor:dispatchingExpose withSync:false] whileTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5426
            self dispatchExposeEventFor:dispatchingExpose
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5427
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5428
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5429
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5430
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5431
    [self eventPendingWithSync:false] whileTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5432
        eventArray isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5433
            eventArray := Array new:13.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5434
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5435
        (self getEventFor:nil withMask:nil into:eventArray) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5436
            AbortOperationRequest handle:[:ex |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5437
                ex return
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5438
            ] do:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5439
                self dispatchEvent:eventArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5440
                "/ multi-screen config: give others a chance
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5441
                "/ (needed because we run at high (non-timesliced) prio)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5442
                Processor yield.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5443
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5444
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5445
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5446
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5447
    "Modified: 19.8.1997 / 17:11:18 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5448
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5449
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5450
disposeEventsWithMask:aMask for:aWindowIdOrNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5451
    "dispose (throw away) specific events. If aWindowId is nil,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5452
     events matching the mask are thrown away regardless of which
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5453
     view they are for. Otherwise, only matching events for that
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5454
     view are flushed."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5455
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5456
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5457
%{ /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5458
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5459
    XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5460
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5461
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5462
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5463
     && __isSmallInteger(aMask)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5464
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5465
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5466
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5467
        if (__isExternalAddress(aWindowIdOrNil)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5468
            win = __WindowVal(aWindowIdOrNil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5469
            while (XCheckWindowEvent(dpy, win, __intVal(aMask), &ev)) ;;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5470
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5471
            while (XCheckMaskEvent(dpy, __intVal(aMask), &ev)) ;;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5472
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5473
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5474
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5475
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5476
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5477
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5478
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5479
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5480
eventMaskFor:anEventSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5481
    "return the eventMask bit-constant corresponding to an event symbol"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5482
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5483
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5484
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5485
    int m = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5486
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5487
    if (anEventSymbol == @symbol(keyPress)) m = KeyPressMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5488
    else if (anEventSymbol == @symbol(keyRelease)) m = KeyReleaseMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5489
    else if (anEventSymbol == @symbol(buttonPress)) m = ButtonPressMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5490
    else if (anEventSymbol == @symbol(buttonRelease)) m = ButtonReleaseMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5491
    else if (anEventSymbol == @symbol(buttonMotion)) m = ButtonMotionMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5492
    else if (anEventSymbol == @symbol(pointerMotion)) m = PointerMotionMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5493
    else if (anEventSymbol == @symbol(expose)) m = ExposureMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5494
    else if (anEventSymbol == @symbol(focusChange)) m = FocusChangeMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5495
    else if (anEventSymbol == @symbol(enter)) m = EnterWindowMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5496
    else if (anEventSymbol == @symbol(leave)) m = LeaveWindowMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5497
    else if (anEventSymbol == @symbol(keymapState)) m = KeymapStateMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5498
    else if (anEventSymbol == @symbol(visibilityChange)) m = VisibilityChangeMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5499
    else if (anEventSymbol == @symbol(structureNotify)) m = StructureNotifyMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5500
    else if (anEventSymbol == @symbol(resizeRedirect)) m = ResizeRedirectMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5501
    else if (anEventSymbol == @symbol(propertyChange)) m = PropertyChangeMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5502
    else if (anEventSymbol == @symbol(colormapChange)) m = ColormapChangeMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5503
    else if (anEventSymbol == @symbol(substructureNotify)) m = SubstructureNotifyMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5504
    else if (anEventSymbol == @symbol(substructureRedirect)) m = SubstructureRedirectMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5505
    RETURN (__MKSMALLINT(m));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5506
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5507
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5508
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5509
eventPending
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5510
    "return true, if any event is pending.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5511
     This looks for both the internal queue and the display connection."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5512
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5513
    "/ ConservativeSync is required for some Xlib implementation,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5514
    "/ where eventPending returns wrong if we do not flush the buffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5515
    "/ (especially Win32 & Xlib)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5516
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5517
    ConservativeSync == true ifTrue:[self sync].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5518
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5519
    dispatchingExpose notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5520
        ^ self exposeEventPendingFor:dispatchingExpose withSync:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5521
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5522
    ^ self eventPendingWithSync:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5523
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5524
    "Modified: / 28.4.1999 / 11:08:12 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5525
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5526
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5527
eventPending:anEventSymbol for:aWindowIdOrNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5528
    "return true, if a specific event is pending"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5529
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5530
    ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil withSync:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5531
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5532
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5533
eventPending:anEventMask for:aWindowIdOrNil withSync:doSync
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5534
    "return true, if any of the masked events is pending"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5535
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5536
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5537
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5538
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5539
    XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5540
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5541
    int thereIsOne;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5542
    OBJ rslt = false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5543
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5544
    if (ISCONNECTED && __isSmallInteger(anEventMask)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5545
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5546
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5547
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5548
        if (doSync == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5549
            XSync(dpy, 0);      /* make certain everything is flushed */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5550
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5551
        if (__isExternalAddress(aWindowIdOrNil)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5552
            win = __WindowVal(aWindowIdOrNil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5553
            thereIsOne = XCheckWindowEvent(dpy, win, __intVal(anEventMask), &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5554
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5555
            thereIsOne = XCheckMaskEvent(dpy, __intVal(anEventMask), &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5556
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5557
        if (thereIsOne) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5558
            XPutBackEvent(dpy, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5559
            rslt = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5560
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5561
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5562
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5563
    RETURN ( rslt );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5564
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5565
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5566
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5567
eventPendingWithSync:doSync
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5568
    "return true, if any event is pending.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5569
     If doSync is true, do a sync output buffer (i.e. send all to the display and wait until its processed)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5570
     before checking."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5571
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5572
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5573
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5574
    OBJ rslt = false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5575
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5576
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5577
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5578
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5579
        if (XEventsQueued(dpy, QueuedAlready)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5580
            RETURN (true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5581
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5582
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5583
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5584
        if (doSync == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5585
            XSync(dpy, 0);      /* make certain everything is flushed */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5586
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5587
        if (XPending(dpy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5588
            rslt = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5589
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5590
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5591
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5592
    RETURN ( rslt );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5593
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5594
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5595
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5596
eventQueued
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5597
    "return true, if any event is queued"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5598
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5599
    dispatchingExpose notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5600
        ^ self exposeEventPendingFor:dispatchingExpose withSync:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5601
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5602
    ^ self eventQueuedAlready
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5603
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5604
    "Created: 12.12.1995 / 21:43:00 / stefan"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5605
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5606
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5607
eventQueuedAlready
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5608
    "return true, if any event is queued internally.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5609
     (i.e. in X's internal event queue, which is both filled by explicit
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5610
      nextEvent calls AND whenever drawing is done and events are pending on
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5611
      the display connection)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5612
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5613
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5614
    OBJ rslt = false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5615
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5616
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5617
        /* ENTER ... LEAVE not needed; XEventsQueued will not block */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5618
        /* ENTER_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5619
        if (XEventsQueued(myDpy, QueuedAlready)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5620
            rslt = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5621
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5622
        /* LEAVE_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5623
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5624
    RETURN ( rslt );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5625
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5626
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5627
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5628
exposeEventPendingFor:aWindowIdOrNil withSync:doSync
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5629
    "return true, if any expose event is pending for a specific view,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5630
     or any view (if the arg is nil).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5631
     This is an X specific, only required after a scroll operation."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5632
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5633
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5634
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5635
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5636
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5637
    XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5638
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5639
    int thereIsOne;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5640
    OBJ rslt = false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5641
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5642
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5643
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5644
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5645
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5646
        if (doSync == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5647
            XSync(dpy, 0);      /* make certain everything is flushed */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5648
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5649
        if (__isExternalAddress(aWindowIdOrNil)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5650
            win = __WindowVal(aWindowIdOrNil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5651
            thereIsOne = XCheckWindowEvent(dpy, win, ExposureMask, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5652
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5653
            thereIsOne = XCheckMaskEvent(dpy, ExposureMask, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5654
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5655
        if (thereIsOne) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5656
            XPutBackEvent(dpy, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5657
            rslt = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5658
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5659
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5660
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5661
    RETURN ( rslt );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5662
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5663
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5664
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5665
getEventFor:aViewIdOrNil withMask:eventMask into:anEventArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5666
    "read next event if there is one and put events data into anEventArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5667
     If aViewIdOrNil is nil, events for any view are fetched;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5668
     otherwise only events for that specific view will be fetched.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5669
     Returns true, if there was an event, false otherwise.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5670
     This method may block - so you better check for pending events
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5671
     before calling for it.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5672
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5673
     The event fields are placed them into anEventArray (must be at least size 13):
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5674
     the fields are:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5675
        1:      windowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5676
        2:      eventType-ID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5677
        3:      eventTypeSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5678
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5679
        4..     args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5680
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5681
     Sorry I had to split dispatch into this fetch method and a separate
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5682
     handler method to allow UNLIMITEDSTACK here.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5683
     (some Xlibs do a big alloca there which cannot be done in
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5684
      #dispatchEvent:, since it dispatches out into ST-methods).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5685
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5686
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5687
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5688
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5689
    Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5690
    Window win, wWanted;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5691
    int evMask, returnValue;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5692
    XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5693
    OBJ eB;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5694
    KeySym keySym;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5695
    unsigned char buffer[64];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5696
    int i, nchars;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5697
    char *keySymString;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5698
    OBJ arg, sym, t, windowID;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5699
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5700
    if (! ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5701
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5702
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5703
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5704
    dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5705
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5706
    ev.type = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5708
    if (__isSmallInteger(eventMask)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5709
        evMask = __intVal(eventMask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5710
    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5711
        evMask = ~0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5712
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5713
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5714
    if (__isExternalAddress(aViewIdOrNil)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5715
        wWanted = __WindowVal(aViewIdOrNil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5716
        returnValue = XCheckWindowEvent(dpy, wWanted, evMask, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5717
    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5718
        if (evMask == ~0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5719
            XNextEvent(dpy, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5720
            returnValue = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5721
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5722
            returnValue = XCheckMaskEvent(dpy, evMask, &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5723
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5724
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5725
    if (!returnValue) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5726
        /* there is no event */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5727
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5728
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5729
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5730
    if (anEventArray == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5731
        /* sender is not interested in the event */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5732
        RETURN(true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5733
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5734
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5735
    if (!__isArray(anEventArray)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5736
        console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5737
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5738
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5739
    if (__arraySize(anEventArray) < 11) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5740
        console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5741
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5742
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5743
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5744
#   define ANYBUTTON   (Button1MotionMask | Button2MotionMask | Button3MotionMask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5745
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5746
#   define ae ((XAnyEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5747
#   define ee ((XExposeEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5748
#   define ke ((XKeyPressedEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5749
#   define be ((XButtonPressedEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5750
#   define ce ((XConfigureEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5751
#   define cr ((XConfigureRequestEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5752
#   define me ((XMotionEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5753
#   define ele ((XCrossingEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5754
#   define de ((XDestroyWindowEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5755
#   define ve ((XVisibilityEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5756
#   define fe ((XFocusChangeEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5757
#   define cre ((XCreateWindowEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5758
#   define mape ((XMappingEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5759
#   define gre ((XGravityEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5760
#   define rr ((XResizeRequestEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5761
#   define rpe ((XReparentEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5762
#   define cie ((XCirculateEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5763
#   define pe ((XPropertyEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5764
#   define sce ((XSelectionClearEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5765
#   define cme ((XColormapEvent *)&ev)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5766
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5767
    if (((t = __INST(lastId)) != nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5768
         && __isExternalAddress(t)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5769
         && (__WindowVal(t) == ae->window)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5770
        windowID = t;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5771
    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5772
        windowID = __MKEXTERNALADDRESS(ae->window);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5773
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5774
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5775
    __ArrayInstPtr(anEventArray)->a_element[0] = windowID; __STORE(anEventArray, windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5776
    __ArrayInstPtr(anEventArray)->a_element[1] = __MKSMALLINT(ev.type);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5777
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5778
    switch (ev.type) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5779
        case KeyRelease:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5780
            sym = @symbol(keyRelease:key:code:state:x:y:rootX:rootY:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5781
            goto keyPressAndRelease;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5782
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5783
        case KeyPress:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5784
            sym = @symbol(keyPress:key:code:state:x:y:rootX:rootY:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5785
            /* FALL INTO */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5786
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5787
        keyPressAndRelease:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5788
            arg = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5789
            nchars = XLookupString(ke, (char *)buffer, sizeof(buffer), &keySym, NULL);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5790
            if (nchars == 1 && (((buffer[0] >= ' ') && (buffer[0] <= '~'))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5791
                || (buffer[0] >= 0x80))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5792
                arg = __MKCHARACTER(buffer[0]);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5793
//            } else if (nchars > 2) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5794
//                arg = __MKSTRING_L(buffer, nchars);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5795
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5796
                keySymString = XKeysymToString(keySym);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5797
                if (keySymString) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5798
                    arg = __MKSYMBOL(keySymString, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5799
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5800
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5801
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5802
#ifdef IGNORE_UNKNOWN_KEYCODES
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5803
            if (arg == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5804
                /* happens sometimes (alt-graph on sun has no keysym) */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5805
                RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5806
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5807
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5808
            __ArrayInstPtr(anEventArray)->a_element[2] = sym;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5809
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5810
            __ArrayInstPtr(anEventArray)->a_element[3] = arg; __STORE(anEventArray, arg);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5811
            t = __MKUINT(ke->keycode); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5812
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ke->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5813
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ke->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5814
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ke->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5815
            __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ke->x_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5816
            __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ke->y_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5817
            t = __MKUINT(ke->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5818
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5819
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5820
        case ButtonPress:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5821
            sym = @symbol(buttonPress:button:state:x:y:rootX:rootY:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5822
            goto buttonPressAndRelease;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5823
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5824
        case ButtonRelease:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5825
            sym = @symbol(buttonRelease:button:state:x:y:rootX:rootY:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5826
            /* fall into */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5827
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5828
        buttonPressAndRelease:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5829
            __ArrayInstPtr(anEventArray)->a_element[2] = sym;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5830
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(be->button);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5831
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ke->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5832
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(be->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5833
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(be->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5834
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(be->x_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5835
            __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(be->y_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5836
            t = __MKUINT(be->time); __ArrayInstPtr(anEventArray)->a_element[9] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5837
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5838
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5839
        case MotionNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5840
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(buttonMotion:state:x:y:rootX:rootY:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5841
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5842
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(me->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5843
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(me->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5844
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(me->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5845
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(me->x_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5846
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(me->y_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5847
            t = __MKUINT(me->time); __ArrayInstPtr(anEventArray)->a_element[8] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5848
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5849
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5850
        case FocusIn:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5851
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusIn:mode:detail:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5852
            goto focusInOut;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5853
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5854
        case FocusOut:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5855
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusOut:mode:detail:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5856
            /* fall into */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5857
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5858
        focusInOut:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5859
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(fe->mode);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5860
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(fe->detail);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5861
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5862
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5863
        case EnterNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5864
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerEnter:x:y:rootX:rootY:state:mode:detail:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5865
            goto enterLeave;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5866
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5867
        case LeaveNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5868
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerLeave:x:y:rootX:rootY:state:mode:detail:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5869
            /* fall into */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5870
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5871
        enterLeave:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5872
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ele->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5873
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ele->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5874
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ele->x_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5875
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ele->y_root);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5876
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ele->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5877
            __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ele->mode);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5878
            __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ele->detail);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5879
            t = __MKUINT(ele->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5880
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5881
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5882
        case Expose:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5883
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(expose:x:y:width:height:count:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5884
            goto expose;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5885
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5886
        case GraphicsExpose:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5887
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(graphicsExpose:x:y:width:height:count:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5888
            /* fall into */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5889
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5890
        expose:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5891
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ee->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5892
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ee->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5893
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ee->width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5894
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ee->height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5895
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ee->count);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5896
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5897
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5898
        case NoExpose:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5899
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(noExposeView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5900
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5901
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5902
        case VisibilityNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5903
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(visibilityNotify:state:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5904
            switch (ve->state) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5905
                case VisibilityUnobscured:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5906
                    __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(unobscured);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5907
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5908
                case VisibilityPartiallyObscured:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5909
                    __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(partiallyObscured);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5910
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5911
                case VisibilityFullyObscured:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5912
                    __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(fullyObscured);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5913
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5914
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5915
                    __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(ve->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5916
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5917
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5918
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5919
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5920
        case CreateNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5921
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(createWindow:x:y:width:height:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5922
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cre->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5923
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cre->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5924
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cre->width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5925
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cre->height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5926
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5927
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5928
        case DestroyNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5929
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(destroyedView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5930
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5931
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5932
        case UnmapNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5933
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unmappedView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5934
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5935
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5936
        case MapNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5937
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappedView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5938
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5939
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5940
        case ConfigureNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5941
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configure:relativeTo:x:y:width:height:borderWidth:above:overrideRedirect:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5942
            __ArrayInstPtr(anEventArray)->a_element[3] = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5943
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ce->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5944
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ce->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5945
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ce->width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5946
            __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ce->height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5947
            __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ce->border_width); 
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5948
           __ArrayInstPtr(anEventArray)->a_element[9] = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5949
            __ArrayInstPtr(anEventArray)->a_element[10] = ce->override_redirect ? true : false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5950
            if (ce->event != None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5951
                t = __MKEXTERNALADDRESS(ce->event); __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5952
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5953
            if (ce->above != None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5954
                t = __MKEXTERNALADDRESS(ce->above); __ArrayInstPtr(anEventArray)->a_element[9] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5955
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5956
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5957
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5958
        case GravityNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5959
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(gravityNotify:x:y:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5960
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(gre->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5961
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(gre->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5962
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5963
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5964
        case ResizeRequest:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5965
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(resizeRequest:width:height:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5966
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(rr->width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5967
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rr->height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5968
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5969
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5970
        case ConfigureRequest:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5971
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configureRequest:x:y:width:height:above:detail:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5972
            __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cr->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5973
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cr->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5974
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cr->width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5975
            __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cr->height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5976
            __ArrayInstPtr(anEventArray)->a_element[7] = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5977
            if (cr->above != None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5978
                t = __MKEXTERNALADDRESS(cr->above); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5979
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5980
            switch (cr->detail) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5981
                case Above:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5982
                    __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(above);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5983
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5984
                case Below:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5985
                    __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(below);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5986
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5987
                case TopIf:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5988
                    __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(topIf);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5989
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5990
                case BottomIf:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5991
                    __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(bottomIf);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5992
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5993
                case Opposite:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5994
                    __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(opposite);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5995
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5996
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5997
                    __ArrayInstPtr(anEventArray)->a_element[8] = __MKSMALLINT(cr->detail);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5998
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  5999
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6000
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6001
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6002
        case CirculateNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6003
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateNotify:place:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6004
            goto circulate;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6005
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6006
        case CirculateRequest:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6007
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateRequest:place:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6008
            /* fall into */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6009
        circulate:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6010
            switch (cie->place) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6011
                case PlaceOnTop:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6012
                    __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnTop);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6013
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6014
                case PlaceOnBottom:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6015
                    __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnBottom);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6016
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6017
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6018
                    __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(cie->place);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6019
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6020
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6021
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6022
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6023
        case PropertyNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6024
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(propertyChange:property:state:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6025
            __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(pe->atom);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6026
            switch (pe->state) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6027
                case PropertyNewValue:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6028
                    __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(newValue);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6029
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6030
                case PropertyDelete:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6031
                    __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(deleted);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6032
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6033
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6034
                    __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(pe->state);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6035
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6036
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6037
            t = __MKUINT(pe->time); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6038
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6039
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6040
        case SelectionClear:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6041
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionClear:selection:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6042
            __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(sce->selection);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6043
            t = __MKUINT(sce->time); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6044
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6045
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6046
        case SelectionRequest:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6047
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6048
             * someone wants the selection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6049
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6050
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionRequest:requestor:selection:target:property:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6051
            t = __MKEXTERNALADDRESS(ev.xselectionrequest.requestor); __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6052
            __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselectionrequest.selection);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6053
            __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselectionrequest.target);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6054
            __ArrayInstPtr(anEventArray)->a_element[6] = __MKATOMOBJ(ev.xselectionrequest.property);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6055
            t = __MKUINT(ev.xselectionrequest.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6056
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6057
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6058
        case SelectionNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6059
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6060
             * returned selection value (answer from SelectionRequest)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6061
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6062
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionNotify:selection:target:property:requestor:time:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6063
            __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xselection.selection);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6064
            __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselection.target);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6065
            __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselection.property);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6066
            t = __MKEXTERNALADDRESS(ev.xselection.requestor); __ArrayInstPtr(anEventArray)->a_element[6] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6067
            t = __MKUINT(ev.xselection.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6068
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6069
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6070
        case ColormapNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6071
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(colormapNotify:state:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6072
            __ArrayInstPtr(anEventArray)->a_element[3] = cme->state == ColormapInstalled ? true : false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6073
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6074
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6075
        case ClientMessage:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6076
            if (ev.xclient.message_type == (int) __AtomVal(__INST(protocolsAtom))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6077
                if ((ev.xclient.data.l[0] == (int) __AtomVal(__INST(quitAppAtom)))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6078
                 || (ev.xclient.data.l[0] == (int) __AtomVal(__INST(deleteWindowAtom)))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6079
                    __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(terminateView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6080
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6081
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6082
                if (ev.xclient.data.l[0] == (int) __AtomVal(__INST(saveYourselfAtom))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6083
                    __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(saveAndTerminateView:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6084
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6085
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6086
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6087
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6088
             * any other client message
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6089
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6090
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(clientMessage:type:format:data:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6091
            __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xclient.message_type);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6092
            __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(ev.xclient.format);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6093
            t = __MKBYTEARRAY(&ev.xclient.data, sizeof(ev.xclient.data)); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6094
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6095
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6096
        case MappingNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6097
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappingNotify:request:event:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6098
            switch(mape->request) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6099
                case MappingModifier:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6100
                    arg = @symbol(mappingModifier);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6101
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6102
                case MappingKeyboard:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6103
                    arg = @symbol(mappingKeyboard);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6104
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6105
                case MappingPointer:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6106
                    arg = @symbol(mappingPointer);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6107
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6108
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6109
                    arg = __MKSMALLINT(mape->request);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6110
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6111
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6112
            __ArrayInstPtr(anEventArray)->a_element[3] = arg;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6113
            t = __MKBYTEARRAY(&ev, sizeof(*mape)); __ArrayInstPtr(anEventArray)->a_element[4] = t;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6114
            __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6115
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6116
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6117
        case KeymapNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6118
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(keymapNotify:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6119
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6120
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6121
        case MapRequest:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6122
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mapRequest:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6123
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6124
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6125
        case ReparentNotify:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6126
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(reparentedView:parentId:x:y:);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6127
            t = __MKEXTERNALADDRESS(rpe->parent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6128
            __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6129
            __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rpe->x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6130
            __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(rpe->y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6131
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6132
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6133
        default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6134
            __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unknownX11Event);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6135
            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6136
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6137
#undef ae
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6138
#undef ee
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6139
#undef ke
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6140
#undef be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6141
#undef ce
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6142
#undef cr
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6143
#undef cre
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6144
#undef cle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6145
#undef gre
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6146
#undef me
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6147
#undef ewe
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6148
#undef ele
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6149
#undef lwe
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6150
#undef de
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6151
#undef mape
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6152
#undef ve
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6153
#undef fe
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6154
#undef rr
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6155
#undef rpe
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6156
#undef pe
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6157
#undef cie
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6158
#undef sce
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6159
#undef cme
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6160
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6161
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6162
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6163
    ^ true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6164
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6165
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6166
handleAllEvents
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6167
    "from now on, handle any kind of event"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6168
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6169
    dispatchingExpose := nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6170
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6171
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6172
handleExposeOnlyFor:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6173
    "from now on, handle expose events only"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6174
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6175
    dispatchingExpose := aView id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6176
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6177
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6178
registerHotKeyForWindow:aDrawableId withId:anId modifiers:aModifier virtualKeyCode:aVirtualKeyCode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6179
    "Defines a system-wide hot key."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6180
    <resource: #todo>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6181
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6182
    "no-op until implemented"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6183
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6184
    ^ false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6185
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6186
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6187
setEventMask:aMask in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6188
    "tell X that we are only interested in events from aMask, which
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6189
     is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6190
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6191
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6192
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6193
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6194
    int mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6195
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6196
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6197
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6198
     && __isSmallInteger(aMask)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6199
        mask = __intVal(aMask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6200
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6201
#ifdef OLD
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6202
        /* these may not be disabled */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6203
        mask |= ExposureMask | StructureNotifyMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6204
                KeyPressMask | KeyReleaseMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6205
                EnterWindowMask | LeaveWindowMask |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6206
                ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6207
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6208
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6209
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6210
        XSelectInput(myDpy, __WindowVal(aWindowId), mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6211
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6212
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6213
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6214
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6215
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6216
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6217
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6218
startDispatch
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6219
    "redefined to clear dispatchingExpose, which is a special X feature"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6220
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6221
    (dispatchProcess notNil and:[dispatchProcess isDead not]) ifTrue:[^ self].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6222
    dispatchingExpose := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6223
    super startDispatch.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6224
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6225
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6226
unregisterHotKeyForWindow:aDrawableId withId:anId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6227
    "Release a system-wide hot key."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6228
    <resource: #todo>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6229
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6230
    "no-op until implemented. Since we never registered anything, the unregister succeeds"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6231
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6232
    ^ true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6233
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6234
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6235
viewIsRelevantInCheckForEndOfDispatch:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6236
    aView == windowGroupWindow ifTrue:[^ false].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6237
    ^ super viewIsRelevantInCheckForEndOfDispatch:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6238
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6239
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6240
!XWorkstation methodsFor:'event handling-old dispatch'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6241
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6242
buttonPress:button x:x y:y view:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6243
    "forward a button-press event for some view"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6244
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6245
    aView isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6246
        "/ event arrived, after I destroyed it myself
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6247
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6248
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6249
    button == 1 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6250
        activateOnClick == true ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6251
            "/ dont raise above an active popup view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6252
            (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6253
                aView topView raise.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6254
"/            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6255
"/                activeKeyboardGrab printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6256
"/                activePointerGrab printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6257
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6258
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6259
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6260
    super buttonPress:button x:x y:y view:aView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6261
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6262
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6263
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6264
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6265
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6266
!XWorkstation methodsFor:'event sending'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6267
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6268
sendClientEvent:msgType format:msgFormat to:targetWindowID propagate:propagate eventMask:eventMask window:windowID data1:d1 data2:d2 data3:d3 data4:d4 data5:d5
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6269
    "send a ClientMessage to some other (possibly: non-ST/X) view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6270
     The client message gets message_type and msgFormat as specified by
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6271
     the arguments. The additional data arguments specify up to
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6272
     5 longWords of user data; each may be an integer or nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6273
     It is passed transparently in the events data field.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6274
     See XProtocol specification for more details."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6275
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6276
    "/ Event.xclient.type              = ClientMessage;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6277
    "/ Event.xclient.display           = dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6278
    "/ Event.xclient.message_type      = msgType;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6279
    "/ Event.xclient.format            = msgFormat;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6280
    "/ Event.xclient.window            = windowID;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6281
    "/ Event.xclient.data.l[0]         = d1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6282
    "/ Event.xclient.data.l[1]         = d2
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6283
    "/ Event.xclient.data.l[2]         = d3
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6284
    "/ Event.xclient.data.l[3]         = d4
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6285
    "/ Event.xclient.data.l[4]         = d5
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6286
    "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6287
    "/ XSendEvent(dpy, targetWindowID, propagate, eventMask, &Event);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6288
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6289
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6290
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6291
    int type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6292
    int state;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6293
    int __eventMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6294
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6295
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6296
     && __isInteger(msgType)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6297
     && __isInteger(msgFormat)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6298
     && (eventMask == nil || __isInteger(eventMask))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6299
     && (__isExternalAddress(windowID) || __isInteger(windowID))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6300
     && (__isExternalAddress(targetWindowID) || __isInteger(targetWindowID))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6301
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6302
        XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6303
        Status result;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6304
        Window targetWindow;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6305
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6306
        if (__isInteger(d1)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6307
            ev.xclient.data.l[0] = __longIntVal(d1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6308
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6309
            if (__isExternalAddress(d1)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6310
                ev.xclient.data.l[0] = (INT)__externalAddressVal(d1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6311
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6312
                ev.xclient.data.l[0] = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6313
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6314
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6315
        if (__isInteger(d2)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6316
            ev.xclient.data.l[1] = __longIntVal(d2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6317
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6318
            if (__isExternalAddress(d2)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6319
                ev.xclient.data.l[1] = (INT)__externalAddressVal(d2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6320
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6321
                ev.xclient.data.l[1] = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6322
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6323
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6324
        if (__isInteger(d3)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6325
            ev.xclient.data.l[2] = __longIntVal(d3);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6326
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6327
            if (__isExternalAddress(d3)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6328
                ev.xclient.data.l[2] = (INT)__externalAddressVal(d3);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6329
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6330
                ev.xclient.data.l[2] = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6331
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6332
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6333
        if (__isInteger(d4)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6334
            ev.xclient.data.l[3] = __longIntVal(d4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6335
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6336
            if (__isExternalAddress(d4)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6337
                ev.xclient.data.l[3] = (INT)__externalAddressVal(d4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6338
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6339
                ev.xclient.data.l[3] = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6340
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6341
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6342
        if (__isInteger(d5)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6343
            ev.xclient.data.l[4] = __longIntVal(d5);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6344
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6345
            if (__isExternalAddress(d5)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6346
                ev.xclient.data.l[4] = (INT)__externalAddressVal(d5);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6347
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6348
                ev.xclient.data.l[4] = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6349
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6350
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6351
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6352
        if (__isExternalAddress(windowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6353
            ev.xclient.window = __WindowVal(windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6354
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6355
            ev.xclient.window = (Window)__longIntVal(windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6356
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6357
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6358
        if (__isExternalAddress(targetWindowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6359
            targetWindow = __WindowVal(targetWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6360
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6361
            targetWindow = (Window)__longIntVal(targetWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6362
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6363
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6364
        ev.xclient.type              = ClientMessage;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6365
        ev.xclient.display           = dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6366
        ev.xclient.message_type      = __longIntVal(msgType);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6367
        ev.xclient.format            = __longIntVal(msgFormat);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6368
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6369
        if (eventMask == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6370
            __eventMask = NoEventMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6371
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6372
            __eventMask = __longIntVal(eventMask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6373
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6374
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6375
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6376
        result = XSendEvent(dpy, targetWindow, (propagate == true ? True : False), __eventMask , &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6377
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6378
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6379
        if ((result == BadValue) || (result == BadWindow)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6380
            DPRINTF(("bad status in sendClientEvent\n"));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6381
            RETURN ( false )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6382
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6383
        RETURN (true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6384
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6385
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6386
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6387
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6388
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6389
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6390
sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6391
    "send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6392
     TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6393
     For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6394
     for key events, it can be either a symbol (as listen in X's keySyms)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6395
     or a numeric keysym code. If state is nil, the modifier bits (shift & control)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6396
     are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6397
     The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6398
     (not very user friendly)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6399
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6400
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6401
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6402
    int type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6403
    int state;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6404
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6405
    if (__isSmallInteger(stateMask)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6406
        state = __intVal(stateMask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6407
    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6408
        state = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6409
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6410
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6411
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6412
     && __isSmallInteger(xPos) && __isSmallInteger(yPos)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6413
     && (__isSmallInteger(keySymCodeOrButtonNr) || __isStringLike(keySymCodeOrButtonNr))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6414
     && (__isExternalAddress(targetId) || __isInteger(targetId))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6415
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6416
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6417
        XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6418
        Window target;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6419
        Status result;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6420
        KeySym keySym, *syms;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6421
        int screen = __intVal(__INST(screen));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6422
        char s[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6423
        int nSyms;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6424
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6425
        if ((typeSymbol == @symbol(keyPress))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6426
         || (typeSymbol == @symbol(keyRelease))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6427
            if (__isStringLike(keySymCodeOrButtonNr)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6428
                keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6429
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6430
                if (__isCharacter(keySymCodeOrButtonNr)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6431
                    s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6432
                    s[1] = '\0';
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6433
                    keySym = XStringToKeysym(s);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6434
                } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6435
                    keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6436
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6437
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6438
            ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6439
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6440
            if (stateMask == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6441
                /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6442
                 * get the modifier from the keySym
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6443
                 */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6444
                nSyms = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6445
                syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6446
                if (syms) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6447
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6448
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6449
                    for (i=0; i<nSyms; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6450
                        if (syms[i] == keySym) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6451
#ifdef MODIFIERDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6452
                            console_printf("modifier-index is %d\n", i);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6453
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6454
                            if (i) state = (1 << (i-1));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6455
                            break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6456
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6457
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6458
                    XFree(syms);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6459
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6460
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6461
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6462
            if ((typeSymbol == @symbol(buttonPress))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6463
             || (typeSymbol == @symbol(buttonRelease))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6464
                if (__isSmallInteger(keySymCodeOrButtonNr)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6465
                    ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6466
                } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6467
                    ev.xbutton.button = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6468
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6469
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6470
                DPRINTF(("invalid sendEvent typeSymbol\n"));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6471
                RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6472
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6473
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6474
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6475
        if (typeSymbol == @symbol(keyPress))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6476
            ev.xany.type = KeyPress;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6477
        else if (typeSymbol == @symbol(keyRelease))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6478
            ev.xany.type = KeyRelease;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6479
        else if (typeSymbol == @symbol(buttonPress))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6480
            ev.xany.type = ButtonPress;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6481
        else if (typeSymbol == @symbol(buttonRelease))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6482
            ev.xany.type = ButtonRelease;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6483
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6484
        if (__isExternalAddress(targetId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6485
            target = __WindowVal(targetId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6486
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6487
            target = (Window) __longIntVal(targetId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6488
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6489
        ev.xkey.window = target;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6490
        ev.xkey.same_screen = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6491
        ev.xkey.subwindow = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6492
        ev.xkey.root = RootWindow(dpy, screen);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6493
        ev.xkey.x = __intVal(xPos);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6494
        ev.xkey.y = __intVal(yPos);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6495
        ev.xkey.state = state;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6496
        ev.xkey.time = CurrentTime;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6497
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6498
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6499
        result = XSendEvent(dpy, target, False, 0 , &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6500
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6501
        if ((result == BadValue) || (result == BadWindow)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6502
            DPRINTF(("bad status\n"));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6503
            RETURN ( false )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6504
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6505
        RETURN (true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6506
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6507
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6508
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6509
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6510
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6511
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6512
!XWorkstation methodsFor:'font stuff'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6513
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6514
createFontFor:aFontName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6515
    "a basic method for X-font allocation; this method allows
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6516
     any font to be aquired (even those not conforming to
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6517
     standard naming conventions, such as cursor, fixed or k14)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6518
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6519
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6520
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6521
%{  /* STACK: 100000 */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6522
    /*** UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6523
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6524
    XFontStruct *newFont;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6525
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6526
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6527
     && __isStringLike(aFontName)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6528
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6529
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6530
        newFont = XLoadQueryFont(myDpy, (char *)__stringVal(aFontName));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6531
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6532
#ifdef COUNT_RESOURCES
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6533
        if (newFont)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6534
            __cnt_font++;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6535
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6536
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6537
        RETURN ( newFont ? __MKEXTERNALADDRESS(newFont) : nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6538
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6539
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6540
    "/ --- disabled due to UNLIMITEDSTACK -- self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6541
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6542
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6543
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6544
decomposeXFontName:aString into:aBlock
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6545
    "extract family, face, style and size from an
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6546
     X-font name
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6547
     1 2     3      4    5     6         7 8      9    10   11   12 13 14       15
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6548
      -brand-family-face-style-moreStyle- -height-size-resX-resY-??-??-registry-encoding;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6549
     evaluate aBlock with these"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6550
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6551
    |family face style moreStyle fheight size
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6552
     resX resY registry encoding coding fields|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6553
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6554
    aString isNil ifTrue:[^ false].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6555
    fields := aString asCollectionOfSubstringsSeparatedBy:$-.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6556
    fields size == 3 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6557
        "take care of old font names: family-style-size"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6558
        family := fields at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6559
        style := fields at:2.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6560
        size := Number readFromString:(fields at:3) onError:[^ false].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6561
    ] ifFalse:[fields size == 2 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6562
        "take care of old font names: family-size"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6563
        family := fields at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6564
        size := Number readFromString:(fields at:2) onError:[^ false].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6565
    ] ifFalse:[fields size >= 15 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6566
        family := fields at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6567
        face := fields at:4.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6568
        style := fields at:5.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6569
        style = 'o' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6570
            style := 'oblique'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6571
        ] ifFalse:[style = 'i' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6572
             style := 'italic'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6573
        ] ifFalse:[style = 'r' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6574
             style := 'roman'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6575
        ]]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6576
        moreStyle := fields at:6.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6577
        (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6578
            style := style, '-', moreStyle.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6579
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6580
        fheight := fields at:8.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6581
        size := (Number readFromString:(fields at:9) onError:[^ false]) / 10.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6582
        resX := fields at:10.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6583
        resY := fields at:11.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6584
        registry := fields at:14.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6585
        encoding := fields at:15.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6586
        coding := registry , '-' , encoding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6587
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6588
        ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6589
    ]]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6590
    aBlock value:family value:face value:style value:size value:coding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6591
    ^ true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6592
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6593
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6594
encodingOf:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6595
    "the fonts encoding - if the font does not provide that info,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6596
     return nil (and assume #ascii, which is a subset of #iso8859-1)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6597
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6598
    |props reg enc coll|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6599
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6600
    props := self fontPropertiesOf:aFontId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6601
    reg := props at:#'CHARSET_REGISTRY' ifAbsent:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6602
    enc := props at:#'CHARSET_ENCODING' ifAbsent:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6603
    coll := props at:#'CHARSET_COLLECTIONS' ifAbsent:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6604
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6605
    reg notNil ifTrue:[ reg := self atomName:reg].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6606
    enc notNil ifTrue:[ enc := self atomName:enc].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6607
    coll notNil ifTrue:[ coll := self atomName:coll].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6608
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6609
    ^ self extractEncodingFromRegistry:reg encoding:enc charSetCollections:coll
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6610
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6611
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6612
       Screen current encodingOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6613
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6614
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6615
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6616
extentsOf:aString from:index1 to:index2 inFont:aFontId into:anArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6617
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6618
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6619
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6620
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6621
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6622
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6623
    char *cp;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6624
    int len, n, i1, i2, l;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6625
#   define NLOCALBUFFER 200
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6626
    XChar2b xlatebuffer[NLOCALBUFFER];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6627
    int nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6628
    int directionReturn, fontAscentReturn, fontDescentReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6629
    XCharStruct overAllReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6630
    OBJ *resultArray;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6631
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6632
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6633
         && __bothSmallInteger(index1, index2)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6634
         && __isExternalAddress(aFontId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6635
         && __isNonNilObject(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6636
        int lMax = __intVal(@global(MaxStringLength));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6637
        f = __FontVal(aFontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6638
        if (! f) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6639
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6640
        if (__isArray(anArray) && __arraySize(anArray) > 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6641
            resultArray = __arrayVal(anArray);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6642
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6643
            resultArray = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6644
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6645
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6646
        i1 = __intVal(index1) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6647
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6648
        if (i1 >= 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6649
            OBJ cls;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6650
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6651
            i2 = __intVal(index2) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6652
            if (i2 < i1) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6653
                RETURN ( __MKSMALLINT(0) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6654
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6655
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6656
            cp = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6657
            l = i2 - i1 + 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6658
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6659
            if (__isStringLike(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6660
                n = __stringSize(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6661
                if (i2 >= n) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6662
                cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6663
                len = XTextExtents(f, cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6664
                                        &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6665
                                        &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6666
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6667
                cls = __qClass(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6668
                nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6669
                cp += nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6670
                n = __byteArraySize(aString) - nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6671
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6672
                if (__isBytes(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6673
                    if (i2 >= n) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6674
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6675
                    cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6676
                    len = XTextExtents(f, cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6677
                                            &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6678
                                            &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6679
                } else  if (__isWords(aString)) { /* TWOBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6680
                    union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6681
                        char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6682
                        unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6683
                    } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6684
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6685
                    XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6686
                    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6687
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6688
                    n = n / 2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6689
                    if (i2 >= n) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6690
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6691
                    cp += (i1 * 2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6692
                    if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6693
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6694
                    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6695
                     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6696
                     * X expects them MSB first
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6697
                     * convert as required
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6698
                     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6699
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6700
                    u.s = 0x1234;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6701
                    if (u.b[0] != 0x12) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6702
                        if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6703
                            cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6704
                        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6705
                            cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6706
                            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6707
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6708
                        for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6709
                            cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6710
                            cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6711
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6712
                        cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6713
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6714
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6715
                    len = XTextExtents16(f, (XChar2b *)cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6716
                                            &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6717
                                            &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6718
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6719
                    if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6720
                        free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6721
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6722
                } else if (__isLongs(aString)) { /* FOURBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6723
                    union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6724
                        char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6725
                        unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6726
                    } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6727
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6728
                    XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6729
                    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6730
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6731
                    n = n / 4;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6732
                    if (i2 >= n) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6733
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6734
                    cp += (i1 * 4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6735
                    if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6736
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6737
                    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6738
                     * For now: X does not support 32bit characters without the new 32Unicode extensions.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6739
                     * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6740
                     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6741
                    if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6742
                        cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6743
                    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6744
                        cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6745
                        mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6746
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6747
                    for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6748
                        int codePoint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6749
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6750
                        codePoint = ((unsigned int32 *)cp)[i];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6751
                        if (codePoint > 0xFFFF) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6752
                            codePoint = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6753
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6754
                        cp2[i].byte1 = codePoint & 0xFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6755
                        cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6756
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6757
                    cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6758
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6759
                    len = XTextExtents16(f, (XChar2b *)cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6760
                                            &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6761
                                            &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6762
                    if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6763
                        free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6764
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6765
                } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6766
                    goto fail;      /*unknown string class */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6767
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6768
            if (resultArray) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6769
                switch (__arraySize(anArray)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6770
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6771
                case 8:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6772
                    resultArray[7] = __MKSMALLINT(directionReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6773
                case 7:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6774
                    resultArray[6] = __MKSMALLINT(fontDescentReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6775
                case 6:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6776
                    resultArray[5] = __MKSMALLINT(fontAscentReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6777
                case 5:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6778
                    resultArray[4] = __MKSMALLINT(overAllReturn.descent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6779
                case 4:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6780
                    resultArray[3] = __MKSMALLINT(overAllReturn.ascent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6781
                case 3:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6782
                    resultArray[2] = __MKSMALLINT(overAllReturn.width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6783
                case 2:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6784
                    resultArray[1] = __MKSMALLINT(overAllReturn.rbearing);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6785
                case 1:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6786
                    resultArray[0] = __MKSMALLINT(overAllReturn.lbearing);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6787
                case 0:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6788
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6789
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6790
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6791
            RETURN ( __MKSMALLINT(overAllReturn.width) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6792
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6793
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6794
#undef NLOCALBUFFER
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6795
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6796
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6797
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6798
    ^ 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6799
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6800
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6801
      |result|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6802
      result := Array new:8.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6803
      Screen current
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6804
        extentsOf:'hello World' from:1 to:11
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6805
        inFont:(Screen current  getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6806
                    family:'courier new'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6807
                    weight:'medium'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6808
                    slant:'r'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6809
                    spacing:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6810
                    pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6811
                    size:10
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6812
                    encoding:#'iso10646-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6813
            )
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6814
        into:result.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6815
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6816
      result
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6817
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6818
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6819
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6820
extractEncodingFromRegistry:registry encoding:encoding charSetCollections:charSetCollections
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6821
    "given registry and encoding as returned by X11,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6822
     generate a single symbol naming the ST/X encoding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6823
     I.e. from registry='ISO8859' and encoding='1', generate #'iso8859-1'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6824
     This is pure magic ..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6825
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6826
    |enc charSets|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6827
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6828
    (registry size ~~ 0) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6829
        enc := registry asLowercase.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6830
        encoding size ~~ 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6831
           enc := enc, '-', encoding asLowercase.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6832
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6833
        enc := enc asSymbol.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6834
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6835
        (encoding size ~~ 0) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6836
            enc := encoding asLowercase asSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6837
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6838
            charSets := charSetCollections.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6839
            (charSets notEmptyOrNil) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6840
                charSets := charSets asUppercase asCollectionOfWords.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6841
                (charSets includes:'ISO8859-1') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6842
                    enc := #'iso8859-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6843
                ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6844
                    (charSets includes:'ISO8859') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6845
                        enc := #iso8859
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6846
                    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6847
                        (charSets includes:'ASCII') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6848
                            enc := #ascii
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6849
                        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6850
                            (charSets includes:'ADOBE-STANDARD') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6851
                                enc := #iso8859
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6852
                            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6853
                        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6854
                    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6855
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6856
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6857
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6858
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6859
    ^  enc
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6860
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6861
    "Created: 17.4.1996 / 14:57:06 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6862
    "Modified: 17.4.1996 / 17:22:35 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6863
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6864
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6865
flushListOfAvailableFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6866
    "flush the cached list of all available fonts on this display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6867
     Required if new fonts have been added on the display server."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6868
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6869
    listOfXFonts := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6870
    XftFontDescription notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6871
        XftFontDescription flushListOfAvailableFonts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6872
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6873
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6874
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6875
     Display flushListOfAvailableFonts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6876
     Display listOfAvailableFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6877
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6878
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6879
    "Modified: 27.9.1995 / 10:54:47 / stefan"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6880
    "Created: 20.2.1996 / 22:55:52 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6881
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6882
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6883
fontDescriptionFromXFontName:aFontNameString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6884
    "extract family, face, style and size from an
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6885
     X-font name
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6886
     1 2     3      4    5     6         7 8      9    10   11   12 13 14       15
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6887
      -brand-family-face-style-moreStyle- -pxlSize-size-resX-resY-??-??-registry-encoding;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6888
     evaluate aBlock with these"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6889
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6890
    |family face style moreStyle size
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6891
     resX resY registry encoding coding fields|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6892
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6893
    aFontNameString isNil ifTrue:[^ nil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6894
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6895
    Error handle:[:ex |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6896
        family := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6897
    ] do:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6898
        fields := aFontNameString asCollectionOfSubstringsSeparatedBy:$-.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6899
        fields size == 3 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6900
            "take care of old font names: family-style-size"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6901
            family := fields at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6902
            style := fields at:2.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6903
            size := Number readFromString:(fields at:3).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6904
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6905
            fields size == 2 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6906
                "take care of old font names: family-size"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6907
                family := fields at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6908
                size := Number readFromString:(fields at:2).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6909
            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6910
                fields size >= 15 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6911
                    family := fields at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6912
                    face := fields at:4.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6913
                    style := fields at:5.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6914
                    style = 'o' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6915
                        style := 'oblique'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6916
                    ] ifFalse:[style = 'i' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6917
                         style := 'italic'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6918
                    ] ifFalse:[style = 'r' ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6919
                         style := 'roman'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6920
                    ]]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6921
                    moreStyle := fields at:6.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6922
                    (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6923
                        style := style, '-', moreStyle.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6924
                    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6925
"/                    pxlSize := (Integer readFromString:(fields at:8)).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6926
                    size := (Number readFromString:(fields at:9)) / 10.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6927
                    resX := fields at:10.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6928
                    resY := fields at:11.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6929
                    registry := fields at:14.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6930
                    encoding := fields at:15.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6931
                    coding := registry , '-' , encoding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6932
                ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6933
                    "/ very old name (such as cursor, 5x7 etc)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6934
                ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6935
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6936
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6937
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6938
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6939
    family notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6940
       ^ FontDescription family:family face:face style:style size:size sizeUnit:#pt encoding:coding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6941
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6942
    ^ FontDescription name:aFontNameString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6943
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6944
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6945
     Screen current fontDescriptionFromXFontName:'-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6946
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6947
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6948
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6949
fontMetricsOf:fontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6950
    "return a fonts metrics info object"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6951
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6952
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6953
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6954
    |info avgAscent avgDescent minCode maxCode dir
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6955
     maxAscent maxDescent minWidth maxWidth avgWidth|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6956
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6957
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6958
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6959
    int len;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6960
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6961
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6962
        if (__isExternalAddress(fontId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6963
            f = __FontVal(fontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6964
            if (f) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6965
                minCode = __MKUINT((f->min_byte1<<8) + f->min_char_or_byte2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6966
                maxCode = __MKUINT((f->max_byte1<<8) + f->max_char_or_byte2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6967
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6968
                if (f->direction == FontLeftToRight) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6969
                    dir = @symbol(LeftToRight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6970
                } else if (f->direction == FontRightToLeft) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6971
                    dir = @symbol(RightToLeft);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6972
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6973
                avgAscent = __MKSMALLINT(f->ascent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6974
                avgDescent = __MKSMALLINT(f->descent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6975
                maxAscent = __MKSMALLINT(f->max_bounds.ascent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6976
                maxDescent = __MKSMALLINT(f->max_bounds.descent);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6977
                minWidth = __MKSMALLINT(f->min_bounds.width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6978
                maxWidth = __MKSMALLINT(f->max_bounds.width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6979
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6980
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6981
                len = XTextWidth(f, "n", 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6982
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6983
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6984
                avgWidth = __MKSMALLINT( len );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6985
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6986
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6987
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6988
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6989
    avgAscent == nil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6990
        self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6991
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6992
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6993
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6994
    "DingBats font returns 0 for maxAscent/maxDescent"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6995
    maxAscent := maxAscent max:avgAscent.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6996
    maxDescent := maxDescent max:avgDescent.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6997
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6998
    info := DeviceWorkstation::DeviceFontMetrics new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  6999
    info
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7000
      ascent:avgAscent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7001
      descent:avgDescent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7002
      maxAscent:maxAscent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7003
      maxDescent:maxDescent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7004
      minWidth:minWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7005
      maxWidth:maxWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7006
      avgWidth:avgWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7007
      minCode:minCode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7008
      maxCode:maxCode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7009
      direction:dir.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7010
    ^ info
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7011
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7012
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7013
     Screen current fontMetricsOf:(View defaultFont onDevice:Screen current) fontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7014
     CharacterSetView openOn:(View defaultFont onDevice:Screen current)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7015
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7016
     Screen current fontMetricsOf:(MenuView defaultFont onDevice:Screen current) fontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7017
     CharacterSetView openOn:(MenuView defaultFont onDevice:Screen current)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7018
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7019
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7020
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7021
fontProperties:propertyNames of:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7022
    "Answer an array with selected property values of a font.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7023
     This is X11-Specific.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7024
     PropertyNames is an array with property names (symbols or strings).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7025
     Nonexistant properties are returned as nil"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7026
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7027
    |props|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7028
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7029
    props := self fontPropertiesOf:aFontId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7030
    ^ propertyNames collect:[:propName | props at:propName ifAbsent:nil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7031
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7032
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7033
     Screen current
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7034
        fontProperties:#(#'PIXEL_SIZE' #'POINT_SIZE' RESOLUTION notExistant)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7035
        of:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7036
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7037
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7038
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7039
fontPropertiesOf:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7040
    "Answer an array with all the properties of a font.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7041
     This is X11-Specific.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7042
     Odd indices contain the property name (atom)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7043
     Even indices contain the property value (atom)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7044
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7045
     Answer nil, if there are no properties"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7046
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7047
    |propsArray result|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7048
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7049
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7050
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7051
    XFontProp *prop;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7052
    int n, i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7053
    OBJ x;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7054
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7055
    if (__isExternalAddress(aFontId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7056
        f = __FontVal(aFontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7057
        if (f && (prop = f->properties) != 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7058
            n = f->n_properties;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7059
            propsArray = __ARRAY_NEW_INT(n*2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7060
            for (i = 0; n; n--, prop++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7061
                x = __MKUINT(prop->name); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7062
                x = __MKUINT(prop->card32); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7063
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7064
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7065
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7066
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7067
    result := Dictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7068
    propsArray notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7069
        propsArray pairWiseDo:[:n :v | result at:(self atomName:n) put:v].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7070
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7071
    ^ result
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7072
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7073
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7074
     Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7075
     Dictionary withKeysAndValues:(Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1'))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7076
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7077
     |d|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7078
     d := Dictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7079
     (Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')) keysAndValuesDo:[:name :value|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7080
          d at:name put:((Screen current atomName:value) ? value)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7081
     ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7082
     d
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7083
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7084
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7085
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7086
fontResolutionOf:fontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7087
    "return the resolution (as dpiX @ dpiY) of the font - this is usually the displays resolution,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7088
     but due to errors in some XServer installations, some use 75dpi fonts on higher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7089
     resolution displays and vice/versa."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7090
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7091
    |props res resX resY|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7092
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7093
    props := self fontProperties:#(#'RESOLUTION_X' #'RESOLUTION_Y' RESOLUTION) of:fontId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7094
    resX := props at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7095
    resY := props at:2.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7096
    (resX notNil and:[resY notNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7097
        ^ resX @ resY
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7098
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7099
    res := props at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7100
    res notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7101
        ^ res @ res
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7102
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7103
    ^ self resolution
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7104
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7105
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7106
      Screen current fontResolutionOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7107
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7108
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7109
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7110
fullFontNameOf:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7111
    "the fonts fullName - this is very device specific and should only be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7112
     used for user feed-back (for example: in the fontPanel).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7113
     If the display/font does not provide that info, return nil."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7114
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7115
    |props fullName|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7116
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7117
    props := self fontPropertiesOf:aFontId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7118
    #('FONT' 'FONT_NAME' 'FULL_NAME' 'FULLNAME' ) do:[:try |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7119
        |fullNameID|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7120
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7121
        fullNameID := props at:try ifAbsent:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7122
        fullNameID notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7123
            fullName := self atomName:fullNameID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7124
            fullName notEmptyOrNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7125
                ^ fullName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7126
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7127
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7128
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7129
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7130
    ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7131
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7132
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7133
     Screen current fullFontNameOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7134
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7135
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7136
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7137
getAvailableFontsMatching:pattern
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7138
    "return an Array filled with font names matching aPattern"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7139
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7140
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7141
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7142
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7143
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7144
    int nnames = 30000;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7145
    int available = nnames + 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7146
    char **fonts;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7147
    OBJ arr, str;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7148
    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7149
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7150
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7151
        if (__isStringLike(pattern)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7152
            for (;;) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7153
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7154
                fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7155
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7156
                if (fonts == 0) RETURN(nil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7157
                if (available < nnames) break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7158
                XFreeFontNames(fonts);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7159
                nnames = available * 2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7160
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7161
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7162
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7163
             * now, that we know the number of font names,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7164
             * create the array ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7165
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7166
            arr = __ARRAY_NEW_INT(available);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7167
            if (arr != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7168
                /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7169
                 * ... and fill it
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7170
                 */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7171
                for (i=0; i<available; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7172
                    __PROTECT__(arr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7173
                    str = __MKSTRING(fonts[i]);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7174
                    __UNPROTECT__(arr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7175
                    __ArrayInstPtr(arr)->a_element[i] = str; __STORE(arr, str);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7176
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7177
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7178
            XFreeFontNames(fonts);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7179
            RETURN (arr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7180
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7181
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7182
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7183
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7184
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7185
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7186
      Screen current getAvailableFontsMatching:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7187
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7188
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7189
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7190
getDefaultFontWithEncoding:encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7191
    "return a default font id - used when class Font cannot
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7192
     find anything usable"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7193
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7194
    |id|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7195
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7196
    id := self createFontFor:'-misc-fixed-*-*-*-*-*-*-*-*-*-*-', encoding.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7197
    id isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7198
        id := self createFontFor:'fixed'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7199
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7200
    ^ id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7201
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7202
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7203
       Screen current getDefaultFontWithEncoding:#'iso10646-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7204
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7205
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7206
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7207
getFontWithFamily:familyString face:faceString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7208
            style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7209
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7210
    "try to get the specified font, if not available, try next smaller
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7211
     font. Access to X-fonts by name is possible, by passing the X font name
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7212
     as family and the other parameters as nil. For example, the cursor font
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7213
     can be aquired that way."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7214
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7215
    |styleString theName theId xlatedStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7216
     id spacing encodingMatch idx roundedSize pixelSize pointSize|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7217
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7218
    styleString := styleArgString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7219
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7220
    sizeArgOrNil notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7221
        roundedSize := sizeArgOrNil rounded asInteger.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7222
        sizeUnit == #px ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7223
            pixelSize := roundedSize.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7224
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7225
            pointSize := roundedSize.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7226
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7227
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7228
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7229
    "special: if face is nil, allow access to X-fonts"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7230
    faceString isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7231
        roundedSize notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7232
            theName := familyString , '-' , roundedSize printString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7233
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7234
            theName := familyString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7235
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7236
        theName notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7237
            theId := self createFontFor:theName.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7238
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7239
        theId isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7240
            theId := self getDefaultFontWithEncoding:encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7241
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7242
        ^ theId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7243
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7244
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7245
    "/ spacing other than 'normal' is contained as last component
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7246
    "/ in style
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7247
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7248
    (styleString notNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7249
     and:[(styleString endsWith:'-narrow')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7250
          or:[styleString endsWith:'-semicondensed']]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7251
        |i|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7252
        i := styleString lastIndexOf:$-.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7253
        spacing := styleString copyFrom:(i+1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7254
        styleString := styleString copyTo:(i-1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7255
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7256
        spacing := 'normal'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7257
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7258
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7259
    xlatedStyle := styleString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7260
    xlatedStyle notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7261
        xlatedStyle := xlatedStyle first asString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7262
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7263
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7264
    encoding isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7265
        encodingMatch := '*-*'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7266
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7267
        idx := encoding indexOf:$-.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7268
        idx ~~ 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7269
            encodingMatch := encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7270
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7271
            encodingMatch := encoding , '-*'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7272
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7273
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7274
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7275
    id := self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7276
            getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7277
            family:familyString asLowercase
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7278
            weight:faceString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7279
            slant:xlatedStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7280
            spacing:spacing
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7281
            pixelSize:pixelSize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7282
            size:pointSize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7283
            encoding:encodingMatch.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7284
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7285
    id isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7286
        (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7287
            "/ too stupid: registries come in both cases
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7288
            "/ and X does not ignore case
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7289
            "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7290
            id := self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7291
                    getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7292
                    family:familyString asLowercase
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7293
                    weight:faceString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7294
                    slant:xlatedStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7295
                    spacing:spacing
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7296
                    pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7297
                    size:roundedSize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7298
                    encoding:encodingMatch asUppercase.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7299
            id isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7300
                id := self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7301
                        getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7302
                        family:familyString asLowercase
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7303
                        weight:faceString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7304
                        slant:xlatedStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7305
                        spacing:spacing
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7306
                        pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7307
                        size:roundedSize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7308
                        encoding:encodingMatch asLowercase.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7309
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7310
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7311
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7312
    ^ id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7313
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7314
    "Modified: 4.7.1996 / 11:38:47 / stefan"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7315
    "Modified: 10.4.1997 / 19:20:06 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7316
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7317
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7318
getFontWithFoundry:foundry family:family weight:weight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7319
              slant:slant spacing:spc pixelSize:pSize size:size
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7320
              encoding:encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7321
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7322
    "get the specified font, if not available, return nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7323
     Individual attributes can be left empty (i.e. '') or nil to match any.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7324
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7325
     foundry: 'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7326
     family:  'helvetica' 'courier' 'times' ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7327
     weight:  'bold' 'medium' 'demi' ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7328
     slant:   'r(oman)' 'i(talic)' 'o(blique)'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7329
     spacing: 'narrow' 'normal' semicondensed' ... usually '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7330
     pixelSize: 16,18 ... usually left empty
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7331
     size:      size in point (1/72th of an inch)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7332
     encoding:  iso8859-*, iso8859-1, iso10646-1 ... '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7333
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7334
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7335
    |theName sizeMatch
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7336
     foundryMatch familyMatch weightMatch slantMatch spcMatch
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7337
     pSizeMatch encodingMatch|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7338
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7339
    "this works only on 'Release >= 3' - X-servers"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7340
    "name is:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7341
        -foundry-family    -weight -slant-
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7342
         sony    helvetica bold     r
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7343
         adobe   courier   medium   i
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7344
         msic    fixed              o
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7345
         ...     ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7346
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7347
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7348
    size isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7349
        sizeMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7350
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7351
        sizeMatch := size printString , '0'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7352
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7353
    foundry isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7354
        foundryMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7355
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7356
        foundryMatch := foundry
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7357
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7358
    family isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7359
        familyMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7360
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7361
        familyMatch := family
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7362
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7363
    weight isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7364
        weightMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7365
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7366
        weightMatch := weight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7367
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7368
    slant isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7369
        slantMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7370
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7371
        slantMatch := slant
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7372
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7373
    spc isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7374
        spcMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7375
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7376
        spcMatch := spc
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7377
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7378
    pSize isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7379
        pSizeMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7380
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7381
        pSizeMatch := pSize printString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7382
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7383
    encoding isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7384
        encodingMatch := '*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7385
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7386
        encodingMatch := encoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7387
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7388
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7389
    theName := ('-' , foundryMatch,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7390
                '-' , familyMatch,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7391
                '-' , weightMatch ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7392
                '-' , slantMatch ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7393
                '-' , spcMatch ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7394
                '-*' ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7395
                '-' , pSizeMatch ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7396
                '-' , sizeMatch ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7397
                '-*-*-*-*' ,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7398
                '-' , encodingMatch).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7399
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7400
"/  Transcript showCR:theName; endEntry.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7401
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7402
    ^ self createFontFor:theName.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7403
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7404
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7405
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7406
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7407
        getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7408
        family:'courier'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7409
        weight:'medium'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7410
        slant:'r'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7411
        spacing:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7412
        pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7413
        size:13
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7414
        encoding:#'iso8859-1'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7415
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7416
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7417
        getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7418
        family:'courier'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7419
        weight:'medium'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7420
        slant:'r'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7421
        spacing:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7422
        pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7423
        size:13
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7424
        encoding:#'iso10646-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7425
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7426
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7427
    "Modified: 10.4.1997 / 19:15:44 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7428
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7429
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7430
heightOf:aString from:index1 to:index2 inFont:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7431
    |resultArray|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7432
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7433
    resultArray := Array new:5.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7434
    self extentsOf:aString from:index1 to:index2 inFont:aFontId into:resultArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7435
    ^ (resultArray at:4) + (resultArray at:5).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7436
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7437
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7438
      Screen current
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7439
        heightOf:'hello world' from:1 to:10
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7440
        inFont:(Screen current  getFontWithFoundry:'*'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7441
                    family:'courier new'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7442
                    weight:'medium'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7443
                    slant:'r'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7444
                    spacing:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7445
                    pixelSize:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7446
                    size:13
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7447
                    encoding:#'iso10646-1'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7448
            ).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7449
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7450
      Screen current
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7451
        heightOf:'hello World gggÖÜ' from:1 to:15
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7452
        inFont:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7453
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7454
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7455
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7456
listOfAvailableFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7457
    "return a list with all available fonts on this display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7458
     Since this takes some time, keep the result of the query for the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7459
     next time. The elements of the returned collection are instances of
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7460
     FontDescription."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7461
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7462
    |names|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7463
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7464
    listOfXFonts isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7465
        names := self getAvailableFontsMatching:'*'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7466
        names isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7467
            "no names returned ..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7468
            ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7469
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7470
        listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7471
        listOfXFonts := FontDescription genericFonts, listOfXFonts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7472
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7473
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7474
    (XftFontDescription notNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7475
            and:[ XftFontDescription isLoaded
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7476
            and:[ true "self queryXftLibrary" ]]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7477
    ) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7478
        UserPreferences current useXftFontsOnly ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7479
            ^ (XftFontDescription listOfAvailableFonts)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7480
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7481
        ^ listOfXFonts , (XftFontDescription listOfAvailableFonts).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7482
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7483
    ^ listOfXFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7484
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7485
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7486
     Display flushListOfAvailableFonts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7487
     Display listOfAvailableFonts.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7488
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7489
     Display getAvailableFontsMatching:'*'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7490
     Display getAvailableFontsMatching:'fixed'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7491
     Display fontsInFamily:'fixed' filtering:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7492
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7493
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7494
    "Modified: 27.9.1995 / 10:54:47 / stefan"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7495
    "Modified: 17.4.1996 / 15:27:57 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7496
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7497
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7498
pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7499
    "return a set of all available font sizes in aFamily/aFace/aStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7500
     on this display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7501
     Redefined to handle X's special case of 0-size (which stands for any)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7502
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7503
    |sizes|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7504
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7505
    sizes := super pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7506
    (sizes notNil and:[sizes isEmpty or:[sizes includes:0]]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7507
        "special: in X11R5 and above, size 0 means:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7508
         there are scaled versions in all sizes available"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7509
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7510
        ^ #(4 5 6 7 8 9 10 11 12 14 16 18 20 22 24 28 32 48 64 72 96 144 192 288)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7511
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7512
    ^ sizes
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7513
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7514
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7515
     Display pixelSizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7516
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7517
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7518
    "Created: 27.2.1996 / 01:38:15 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7519
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7520
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7521
releaseFont:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7522
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7523
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7524
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7525
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7526
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7527
    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7528
     * ignore closed connection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7529
     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7530
    if (! ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7531
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7532
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7533
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7534
    if (__isExternalAddress(aFontId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7535
        f = __FontVal(aFontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7536
        if (f) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7537
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7538
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7539
            XFreeFont(myDpy, f);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7540
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7541
#ifdef COUNT_RESOURCES
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7542
            __cnt_font--;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7543
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7544
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7545
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7546
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7547
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7548
    self primitiveFailed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7549
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7550
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7551
sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7552
    "return a set of all available font sizes in aFamily/aFace/aStyle
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7553
     on this display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7554
     Redefined to handle X's special case of 0-size (which stands for any)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7555
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7556
    |sizes|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7557
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7558
    sizes := super sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7559
    (sizes notNil and:[sizes includes:0]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7560
	"special: in X11R5 and above, size 0 means:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7561
	 there are scaled versions in all sizes available"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7562
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7563
	^ #(4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 20 22 24 28 32 48 64 72 96 144 192 288)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7564
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7565
    ^ sizes
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7566
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7567
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7568
     Display sizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7569
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7570
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7571
    "Created: 27.2.1996 / 01:38:15 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7572
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7573
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7574
widthOf:aString from:index1 to:index2 inFont:aFontId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7575
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7576
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7577
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7578
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7579
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7580
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7581
    char *cp;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7582
    int len, n, i1, i2, l;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7583
#   define NLOCALBUFFER 200
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7584
    XChar2b xlatebuffer[NLOCALBUFFER];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7585
    int nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7586
    int directionReturn, fontAscentReturn, fontDescentReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7587
    XCharStruct overAllReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7588
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7589
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7590
        if (__bothSmallInteger(index1, index2)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7591
         && __isExternalAddress(aFontId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7592
         && __isNonNilObject(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7593
            int lMax = __intVal(@global(MaxStringLength));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7594
            f = __FontVal(aFontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7595
            if (! f) goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7596
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7597
            i1 = __intVal(index1) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7598
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7599
            if (i1 >= 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7600
                OBJ cls;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7601
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7602
                i2 = __intVal(index2) - 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7603
                if (i2 < i1) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7604
                    RETURN ( __MKSMALLINT(0) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7605
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7606
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7607
                cp = (char *) __stringVal(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7608
                l = i2 - i1 + 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7609
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7610
                if (__isStringLike(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7611
                    n = __stringSize(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7612
                    if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7613
                        cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7614
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7615
#if 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7616
                        len = XTextExtents(f, cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7617
                                                &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7618
                                                &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7619
                        //console_printf("lBear:%d rBear:%d width:%d\n", overAllReturn.lbearing, overAllReturn.rbearing, overAllReturn.width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7620
                        RETURN ( __MKSMALLINT(overAllReturn.width) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7621
#else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7622
                        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7623
                        len = XTextWidth(f, cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7624
                        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7625
                        RETURN ( __MKSMALLINT(len) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7626
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7627
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7628
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7629
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7630
                cls = __qClass(aString);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7631
                nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7632
                cp += nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7633
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7634
                if (__isBytes(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7635
                    n = __byteArraySize(aString) - nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7636
                    if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7637
                        cp += i1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7638
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7639
#if 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7640
                        len = XTextExtents(f, cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7641
                                                &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7642
                                                &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7643
                        RETURN ( __MKSMALLINT(overAllReturn.width) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7644
#else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7645
                        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7646
                        len = XTextWidth(f, cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7647
                        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7648
                        RETURN ( __MKSMALLINT(len) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7649
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7650
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7651
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7652
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7653
                /* TWOBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7654
                if (__isWords(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7655
                    n = (__byteArraySize(aString) - nInstBytes) / 2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7656
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7657
                    if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7658
                        union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7659
                            char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7660
                            unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7661
                        } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7662
                        int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7663
                        XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7664
                        int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7665
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7666
                        cp += (i1 * 2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7667
                        if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7668
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7669
                        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7670
                         * ST/X TwoByteStrings store the asciiValue in native byteOrder;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7671
                         * X expects them MSB first
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7672
                         * convert as required
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7673
                         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7674
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7675
                        u.s = 0x1234;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7676
                        if (u.b[0] != 0x12) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7677
                            if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7678
                                cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7679
                            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7680
                                cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7681
                                mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7682
                            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7683
                            for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7684
                                cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7685
                                cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7686
                            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7687
                            cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7688
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7689
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7690
#if 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7691
                        len = XTextExtents16(f, (XChar2b *)cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7692
                                                &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7693
                                                &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7694
                        len = overAllReturn.width;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7695
#else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7696
                        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7697
                        len = XTextWidth16(f, (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7698
                        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7699
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7700
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7701
                        if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7702
                            free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7703
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7704
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7705
                        RETURN ( __MKSMALLINT(len) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7706
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7707
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7708
                /* FOURBYTESTRINGS */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7709
                if (__isLongs(aString)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7710
                    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7711
                    XChar2b *cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7712
                    int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7713
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7714
                    n = (__byteArraySize(aString) - nInstBytes) / 4;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7715
                    if (i2 < n) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7716
                        union {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7717
                            char b[2];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7718
                            unsigned short s;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7719
                        } u;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7720
                        int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7721
                        XChar2b *cp2 = (XChar2b *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7722
                        int mustFree = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7723
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7724
                        cp += (i1 * 4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7725
                        if (l > lMax) l = lMax;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7726
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7727
                        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7728
                         * For now: X does not support 32bit characters without the new 32Unicode extensions.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7729
                         * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7730
                         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7731
                        if (l <= NLOCALBUFFER) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7732
                            cp2 = xlatebuffer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7733
                        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7734
                            cp2 = (XChar2b *)(malloc(l * 2));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7735
                            mustFree = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7736
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7737
                        for (i=0; i<l; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7738
                            int codePoint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7739
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7740
                            codePoint = ((unsigned int32 *)cp)[i];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7741
                            if (codePoint > 0xFFFF) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7742
                                codePoint = 0xFFFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7743
                            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7744
                            cp2[i].byte1 = codePoint & 0xFF;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7745
                            cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7746
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7747
                        cp = (char *) cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7748
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7749
#if 1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7750
                        len = XTextExtents16(f, (XChar2b *)cp, l,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7751
                                                &directionReturn, &fontAscentReturn, &fontDescentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7752
                                                &overAllReturn);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7753
                        len = overAllReturn.width;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7754
#else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7755
                        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7756
                        len = XTextWidth16(f, (XChar2b *)cp, l);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7757
                        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7758
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7759
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7760
                        if (mustFree) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7761
                            free(cp2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7762
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7763
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7764
                        RETURN ( __MKSMALLINT(len) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7765
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7766
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7767
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7768
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7769
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7770
#undef NLOCALBUFFER
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7771
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7772
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7773
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7774
    ^ 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7775
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7776
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7777
!XWorkstation methodsFor:'grabbing'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7778
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7779
allowEvents:mode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7780
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7781
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7782
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7783
    int _mode, ok = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7784
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7785
    if (mode == @symbol(asyncPointer))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7786
        _mode = AsyncPointer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7787
    else if (mode == @symbol(syncPointer))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7788
        _mode = SyncPointer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7789
    else if (mode == @symbol(asyncKeyboard))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7790
        _mode = AsyncKeyboard;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7791
    else if (mode == @symbol(syncKeyboard))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7792
        _mode = SyncKeyboard;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7793
    else if (mode == @symbol(syncBoth))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7794
        _mode = SyncBoth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7795
    else if (mode == @symbol(asyncBoth))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7796
        _mode = AsyncBoth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7797
    else if (mode == @symbol(replayPointer))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7798
        _mode = ReplayPointer;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7799
    else if (mode == @symbol(replayKeyboard))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7800
        _mode = ReplayKeyboard;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7801
    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7802
        ok = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7803
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7804
    if (ok
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7805
     && ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7806
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7807
        XAllowEvents(myDpy, _mode, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7808
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7809
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7810
        RETURN (self);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7811
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7812
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7813
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7814
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7815
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7816
grabKeyboardIn:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7817
    "grab the keyboard"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7818
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7819
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7820
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7821
    int result, ok;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7822
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7823
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7824
        if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7825
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7826
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7827
            result = XGrabKeyboard(myDpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7828
                                   __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7829
                                   True /* False */,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7830
                                   GrabModeAsync,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7831
                                   GrabModeAsync,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7832
                                   CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7833
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7834
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7835
            ok = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7836
            switch(result) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7837
                case AlreadyGrabbed:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7838
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7839
                        console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: AlreadyGrabbed\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7840
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7841
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7842
                case GrabNotViewable:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7843
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7844
                        console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: GrabNotViewable\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7845
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7846
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7847
                case GrabInvalidTime:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7848
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7849
                        console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: InvalidTime\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7850
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7851
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7852
                case GrabFrozen:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7853
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7854
                        console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: Frozen\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7855
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7856
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7857
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7858
                    ok = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7859
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7860
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7861
            if (! ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7862
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7863
                XUngrabKeyboard(myDpy, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7864
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7865
                RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7866
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7867
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7868
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7869
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7870
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7871
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7872
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7873
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7874
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7875
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7876
grabPointerIn:aWindowId withCursor:aCursorId eventMask:eventMask pointerMode:pMode keyboardMode:kMode confineTo:confineId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7877
    "grap the pointer - return true if ok"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7878
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7879
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7880
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7881
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7882
    int result, ok, evMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7883
    Window confineWin;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7884
    Cursor curs;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7885
    int pointer_mode, keyboard_mode;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7886
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7887
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7888
        if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7889
            if (__isExternalAddress(confineId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7890
                confineWin = __WindowVal(confineId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7891
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7892
                confineWin = (Window) None;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7893
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7894
            if (__isExternalAddress(aCursorId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7895
                curs = __CursorVal(aCursorId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7896
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7897
                curs = (Cursor) None;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7898
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7899
            if (pMode == @symbol(sync))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7900
                pointer_mode = GrabModeSync;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7901
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7902
                pointer_mode = GrabModeAsync;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7903
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7904
            if (kMode == @symbol(sync))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7905
                keyboard_mode = GrabModeSync;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7906
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7907
                keyboard_mode = GrabModeAsync;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7908
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7909
            if (__isSmallInteger(eventMask))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7910
                evMask = __intVal(eventMask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7911
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7912
                evMask = ButtonPressMask | ButtonMotionMask | PointerMotionMask | ButtonReleaseMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7913
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7914
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7915
/*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7916
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7917
*/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7918
            result = XGrabPointer(myDpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7919
                                  __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7920
                                  False,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7921
                                  evMask,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7922
                                  pointer_mode, keyboard_mode,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7923
                                  confineWin,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7924
                                  curs,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7925
                                  CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7926
/*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7927
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7928
*/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7929
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7930
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7931
            ok = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7932
            switch (result) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7933
                case AlreadyGrabbed:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7934
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7935
                        console_fprintf(stderr, "XWorkstation [warning]: grab pointer: AlreadyGrabbed\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7936
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7937
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7938
                case GrabNotViewable:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7939
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7940
                        console_fprintf(stderr, "XWorkstation [warning]: grab pointer: GrabNotViewable\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7941
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7942
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7943
                case GrabInvalidTime:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7944
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7945
                        console_fprintf(stderr, "XWorkstation [warning]: grab pointer: InvalidTime\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7946
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7947
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7948
                case GrabFrozen:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7949
                    if (@global(ErrorPrinting) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7950
                        console_fprintf(stderr, "XWorkstation [warning]: grab pointer: Frozen\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7951
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7952
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7953
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7954
                    ok = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7955
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7956
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7957
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7958
            if (! ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7959
/*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7960
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7961
*/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7962
                XUngrabPointer(myDpy, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7963
/*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7964
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7965
*/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7966
                RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7967
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7968
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7969
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7970
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7971
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7972
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7973
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7974
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7975
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7976
grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7977
    "grap the pointer - return true if ok"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7978
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7979
    ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7980
        grabPointerIn:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7981
        withCursor:aCursorId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7982
        eventMask:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7983
        pointerMode:pMode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7984
        keyboardMode:kMode
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7985
        confineTo:confineId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7986
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7987
    "Modified: / 28.7.1998 / 02:47:51 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7988
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7989
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7990
primUngrabKeyboard
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7991
    "release the keyboard"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7992
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7993
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7994
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7995
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7996
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7997
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7998
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  7999
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8000
        XUngrabKeyboard(dpy, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8001
        XSync(dpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8002
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8003
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8004
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8005
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8006
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8007
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8008
primUngrabPointer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8009
    "release the pointer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8010
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8011
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8012
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8013
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8014
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8015
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8016
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8017
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8018
        XUngrabPointer(dpy, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8019
        XSync(dpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8020
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8021
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8022
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8023
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8024
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8025
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8026
ungrabKeyboard
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8027
    "release the keyboard"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8028
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8029
    activeKeyboardGrab notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8030
        activeKeyboardGrab := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8031
        self primUngrabKeyboard.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8032
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8033
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8034
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8035
ungrabPointer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8036
    "release the pointer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8037
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8038
    activePointerGrab notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8039
        activePointerGrab := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8040
        self primUngrabPointer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8041
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8042
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8043
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8044
!XWorkstation methodsFor:'graphic context stuff'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8045
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8046
noClipIn:aDrawableId gc:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8047
    "disable clipping rectangle"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8048
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8049
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8050
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8051
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8052
    XGCValues gcv;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8053
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8054
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8055
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8056
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8057
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8058
            gcv.clip_mask = None;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8059
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8060
            XChangeGC(myDpy, gc, GCClipMask, &gcv);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8061
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8062
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8063
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8064
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8065
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8066
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8067
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8068
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8069
setBackground:bgColorIndex in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8070
    "set background color to be drawn with"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8071
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8072
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8073
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8074
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8075
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8076
        if (__isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8077
         && __isSmallInteger(bgColorIndex)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8078
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8079
            XSetBackground(myDpy, __GCVal(aGCId), __intVal(bgColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8080
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8081
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8082
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8083
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8084
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8085
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8086
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8087
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8088
setBitmapMask:aBitmapId in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8089
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8090
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8091
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8092
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8093
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8094
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8095
    Pixmap bitmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8096
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8097
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8098
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8099
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8100
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8101
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8102
            if (__isExternalAddress(aBitmapId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8103
                bitmap = __PixmapVal(aBitmapId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8104
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8105
                XSetStipple(dpy, gc, bitmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8106
                XSetFillStyle(dpy, gc, FillOpaqueStippled);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8107
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8108
                RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8109
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8110
            if (aBitmapId == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8111
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8112
                XSetFillStyle(dpy, gc, FillSolid);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8113
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8114
                RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8115
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8116
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8117
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8118
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8119
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8120
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8121
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8122
setClipByChildren:aBool in:aDrawableId gc:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8123
    "enable/disable drawing into child views"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8124
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8125
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8126
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8127
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8128
    XGCValues gcv;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8129
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8130
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8131
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8132
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8133
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8134
            if (aBool == true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8135
                gcv.subwindow_mode = ClipByChildren;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8136
            else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8137
                gcv.subwindow_mode = IncludeInferiors;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8138
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8139
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8140
            XChangeGC(myDpy, gc, GCSubwindowMode, &gcv);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8141
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8142
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8143
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8144
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8145
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8146
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8147
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8148
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8149
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:drawableId gc:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8150
    "clip to a rectangle"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8151
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8152
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8153
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8154
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8155
    XRectangle r;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8156
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8157
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8158
        if (__isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8159
         && __bothSmallInteger(clipX, clipY)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8160
         && __bothSmallInteger(clipWidth, clipHeight)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8161
            r.x = __intVal(clipX);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8162
            r.y = __intVal(clipY);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8163
            r.width = __intVal(clipWidth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8164
            r.height = __intVal(clipHeight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8165
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8166
            XSetClipRectangles(myDpy, __GCVal(aGCId), 0, 0, &r, 1, Unsorted);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8167
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8168
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8169
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8170
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8171
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8172
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8173
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8174
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8175
setDashes:dashList dashOffset:offset in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8176
    "set line attributes"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8177
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8178
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8179
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8180
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8181
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8182
        if (__isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8183
         && __isSmallInteger(offset)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8184
         && __isByteArrayLike(dashList)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8185
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8186
            XSetDashes(myDpy, __GCVal(aGCId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8187
                       __intVal(offset),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8188
                       __ByteArrayInstPtr(dashList)->ba_element,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8189
                       __byteArraySize(dashList));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8190
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8191
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8192
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8193
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8194
bad: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8195
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8196
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8197
     either aGCId is invalid,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8198
     and/or dashList is not a byteArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8199
     and/or offset is not a smallInteger
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8200
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8201
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8202
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8203
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8204
setFont:aFontId in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8205
    "set font to be drawn in"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8206
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8207
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8208
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8209
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8210
    XFontStruct *f;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8211
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8212
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8213
        if (__isExternalAddress(aFontId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8214
         && __isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8215
            f = (XFontStruct *) __FontVal(aFontId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8216
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8217
            XSetFont(myDpy, __GCVal(aGCId), f->fid);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8218
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8219
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8220
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8221
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8222
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8223
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8224
     aGCId and/or aFontId are invalid
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8225
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8226
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8227
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8228
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8229
setForeground:fgColorIndex background:bgColorIndex in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8230
    "set foreground and background colors to be drawn with"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8231
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8232
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8233
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8234
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8235
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8236
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8237
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8238
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8239
        if (__bothSmallInteger(fgColorIndex, bgColorIndex)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8240
         && __isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8241
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8242
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8243
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8244
            XSetForeground(dpy, gc, __intVal(fgColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8245
            XSetBackground(dpy, gc, __intVal(bgColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8246
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8247
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8248
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8249
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8250
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8251
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8252
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8253
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8254
setForeground:fgColorIndex in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8255
    "set foreground color to be drawn with"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8256
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8257
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8258
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8259
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8260
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8261
        if (__isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8262
         && __isSmallInteger(fgColorIndex)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8263
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8264
            XSetForeground(myDpy, __GCVal(aGCId), __intVal(fgColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8265
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8266
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8267
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8268
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8269
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8270
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8271
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8272
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8273
setFunction:aFunctionSymbol in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8274
    "set alu function to be drawn with"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8275
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8276
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8277
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8278
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8279
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8280
    int fun = -1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8281
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8282
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8283
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8284
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8285
            if (aFunctionSymbol == @symbol(copy)) fun = GXcopy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8286
            else if (aFunctionSymbol == @symbol(copyInverted)) fun = GXcopyInverted;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8287
            else if (aFunctionSymbol == @symbol(xor)) fun = GXxor;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8288
            else if (aFunctionSymbol == @symbol(and)) fun = GXand;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8289
            else if (aFunctionSymbol == @symbol(andReverse)) fun = GXandReverse;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8290
            else if (aFunctionSymbol == @symbol(andInverted)) fun = GXandInverted;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8291
            else if (aFunctionSymbol == @symbol(or)) fun = GXor;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8292
            else if (aFunctionSymbol == @symbol(orReverse)) fun = GXorReverse;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8293
            else if (aFunctionSymbol == @symbol(orInverted)) fun = GXorInverted;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8294
            else if (aFunctionSymbol == @symbol(invert)) fun = GXinvert;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8295
            else if (aFunctionSymbol == @symbol(clear)) fun = GXclear;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8296
            else if (aFunctionSymbol == @symbol(set)) fun = GXset;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8297
            else if (aFunctionSymbol == @symbol(noop)) fun = GXnoop;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8298
            else if (aFunctionSymbol == @symbol(equiv)) fun = GXequiv;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8299
            else if (aFunctionSymbol == @symbol(nand)) fun = GXnand;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8300
            if (fun != -1) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8301
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8302
                XSetFunction(myDpy, gc, fun);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8303
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8304
                RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8305
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8306
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8307
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8308
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8309
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8310
     either aGCId is not an integer, or an invalid symbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8311
     was passed ... valid functions are #copy, #copyInverted, #xor, #and, #andReverse,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8312
     #andInverted, #or, #orReverse, #orInverted. See Xlib documentation for more details.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8313
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8314
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8315
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8316
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8317
setGraphicsExposures:aBoolean in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8318
    "set or clear the graphics exposures flag"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8319
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8320
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8321
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8322
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8323
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8324
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8325
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8326
            XSetGraphicsExposures(myDpy, __GCVal(aGCId), (aBoolean==true)?1:0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8327
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8328
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8329
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8330
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8331
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8332
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8333
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8334
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8335
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8336
    "set line attributes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8337
     lineStyle must be one of #solid, #dashed or #doubleDashed;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8338
     capStyle one of: #notLast, #butt, #round or #projecting;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8339
     joinStyle one of: #miter, #bevel or #round."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8340
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8341
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8342
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8343
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8344
    int x_style, x_cap, x_join;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8345
    static char dashList[2] = { 4,4 };
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8346
    static char dotList[2]  = { 1,1 };
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8347
    static char dashDotList[4]    = { 4,1 , 1,1 };
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8348
    static char dashDotDotList[6] = { 4,1 , 1,1 , 1,1 };
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8349
    char *x_dashes = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8350
    int x_nDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8351
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8352
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8353
        if (__isExternalAddress(aGCId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8354
         && __isSmallInteger(aNumber)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8355
            Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8356
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8357
            if (lineStyle == @symbol(solid)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8358
                x_dashes = (char *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8359
                x_style = LineSolid;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8360
            } else if (lineStyle == @symbol(dashed)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8361
                x_dashes = dashList;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8362
                x_nDash = sizeof(dashList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8363
                x_style = LineOnOffDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8364
            } else if (lineStyle == @symbol(doubleDashed)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8365
                x_dashes = dashList;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8366
                x_nDash = sizeof(dashList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8367
                x_style = LineDoubleDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8368
            } else if (lineStyle == @symbol(dotted)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8369
                x_dashes = dotList;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8370
                x_nDash = sizeof(dotList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8371
                x_style = LineOnOffDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8372
            } else if (lineStyle == @symbol(dashDot)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8373
                x_dashes = dashDotList;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8374
                x_nDash = sizeof(dashDotList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8375
                x_style = LineOnOffDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8376
            } else if (lineStyle == @symbol(dashDotDot)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8377
                x_dashes = dashDotDotList;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8378
                x_nDash = sizeof(dashDotDotList);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8379
                x_style = LineOnOffDash;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8380
            } else goto bad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8381
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8382
            if (capStyle == @symbol(notLast)) x_cap = CapNotLast;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8383
            else if (capStyle == @symbol(butt)) x_cap = CapButt;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8384
            else if (capStyle == @symbol(round)) x_cap  = CapRound;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8385
            else if (capStyle == @symbol(projecting)) x_cap  = CapProjecting;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8386
            else goto bad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8387
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8388
            if (joinStyle == @symbol(miter)) x_join = JoinMiter;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8389
            else if (joinStyle == @symbol(bevel)) x_join = JoinBevel;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8390
            else if (joinStyle == @symbol(round)) x_join  = JoinRound;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8391
            else goto bad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8392
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8393
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8394
            if (x_dashes) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8395
                XSetDashes(dpy, __GCVal(aGCId), 0, x_dashes, x_nDash);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8396
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8397
            XSetLineAttributes(dpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8398
                               __GCVal(aGCId), __intVal(aNumber),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8399
                               x_style, x_cap, x_join);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8400
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8401
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8402
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8403
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8404
bad: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8405
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8406
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8407
     either aGCId is invalid,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8408
     and/or lineWidth is not a smallInteger,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8409
     and/or lineStyle is none of #solid, #dashed, #doubleDashed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8410
     and/or capStyle is none of #notLast, #butt, #round, #projecting
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8411
     and/or joinStyle is none of #miter, #bevel, #round
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8412
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8413
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8414
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8415
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8416
setMaskOriginX:orgX y:orgY in:aGCid
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8417
    "set the mask origin"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8418
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8419
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8420
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8421
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8422
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8423
        if (__bothSmallInteger(orgX, orgY) && __isExternalAddress(aGCid)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8424
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8425
            XSetTSOrigin(myDpy, __GCVal(aGCid), __intVal(orgX), __intVal(orgY));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8426
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8427
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8428
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8429
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8430
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8431
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8432
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8433
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8434
setPixmapMask:aPixmapId in:aGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8435
    "set or clear the drawing mask - a pixmap mask providing full color"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8436
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8437
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8438
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8439
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8440
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8441
    Pixmap pixmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8442
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8443
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8444
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8445
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8446
        if (__isExternalAddress(aGCId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8447
            gc = __GCVal(aGCId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8448
            if (__isExternalAddress(aPixmapId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8449
                pixmap = __PixmapVal(aPixmapId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8450
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8451
                XSetTile(dpy, gc, pixmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8452
                XSetFillStyle(dpy, gc, FillTiled);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8453
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8454
                RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8455
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8456
            if (aPixmapId == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8457
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8458
                XSetFillStyle(dpy, gc, FillSolid);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8459
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8460
                RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8461
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8462
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8463
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8464
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8465
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8466
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8467
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8468
!XWorkstation methodsFor:'initialization & release'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8469
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8470
closeConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8471
    "close down the connection to the X-server"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8473
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8474
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8475
"/ 'closing' errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8476
"/ thisContext fullPrintAll.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8477
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8478
%{ /* UNLIMITEDSTACK */   /* calls XSync()! */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8479
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8480
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8481
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8482
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8483
        __INST(displayId) = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8484
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8485
        XCloseDisplay(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8486
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8487
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8488
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8489
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8490
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8491
emergencyCloseConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8492
    "low level close of the displays connection (without sending any buffered
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8493
     requests to the display). Only used in case of emergency (brokenConnection)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8494
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8495
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8496
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8497
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8498
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8499
        __INST(displayId) = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8500
        close(ConnectionNumber(dpy));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8501
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8502
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8503
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8504
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8505
eventBufferSize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8506
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8507
    RETURN ( __MKSMALLINT(sizeof(XEvent) + 100) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8508
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8509
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8510
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8511
getWindowGroupWindow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8512
    "Creates a fake WindowGroup view. This window is used
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8513
     in XWMHints & _NET_WM_LEADER properties to define
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8514
     application window group"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8515
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8516
    windowGroupWindow isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8517
        windowGroupWindow := WindowGroupWindow new create.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8518
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8519
    ^ windowGroupWindow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8520
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8521
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8522
initializeDefaultValues
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8523
    activateOnClick := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8524
    maxOperationsUntilFlush := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8525
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8526
    super initializeDefaultValues.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8527
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8528
    "JV@2012: On X11, mouse buttons are: left=1, middle=2, right=3
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8529
    Even on 2-button mouse (button 2 is simply not reported).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8530
    Here the middle button is mapped to button #paste (which in EditTextView
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8531
    pastes the PRIMARY selection). 128 is here to make clear that this
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8532
    is somewhat special value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8533
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8534
    This remapping kludge is here to have all the widget's code backward/windows
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8535
    compatible while still having X11's middle button behavior.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8536
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8537
    Also note, that buttonTranslation is overwritten in display.rc,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8538
    the code is here just for a case display.rc is not read/available
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8539
    and for documentation (symbol references does not search .rc files).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8540
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8541
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8542
    buttonTranslation := buttonTranslation copy.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8543
    buttonTranslation at: 2 put: #paste
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8544
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8545
    "Modified (comment): / 17-04-2012 / 21:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8546
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8547
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8548
initializeDeviceSignals
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8549
    super initializeDeviceSignals.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8550
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8551
    deviceIOTimeoutErrorSignal := deviceIOErrorSignal newSignal.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8552
    deviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8553
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8554
    ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8555
    ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOError.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8556
    ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOTimeoutError.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8557
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8558
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8559
initializeFor:aDisplayName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8560
    "initialize the receiver for a connection to an X-Server;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8561
     the argument, aDisplayName may be nil (for the default server from
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8562
     DISPLAY-variable or command line argument) or the name of the server
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8563
     as hostname:number"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8564
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8565
    displayId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8566
        "/ already connected - you bad guy try to trick me manually ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8567
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8568
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8569
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8570
    displayId := self openConnectionTo:aDisplayName.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8571
    displayId isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8572
        "/ could not connect.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8573
        DeviceOpenErrorSignal raiseWith:aDisplayName.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8574
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8575
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8576
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8577
    xlibTimeout := xlibTimeout ? DefaultXLibTimeout.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8578
    xlibTimeoutForWindowCreation := xlibTimeoutForWindowCreation ? DefaultXLibTimeoutForWindowCreation.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8579
    hasConnectionBroken := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8580
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8581
    dispatching := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8582
    dispatchingExpose := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8583
    isSlow := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8584
    shiftDown := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8585
    ctrlDown := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8586
    metaDown := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8587
    altDown := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8588
    motionEventCompression := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8589
    buttonsPressed := 0.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8590
    displayName := aDisplayName.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8591
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8592
    listOfXFonts := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8593
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8594
    atoms := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8595
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8596
    "These values are initialized by primitive code in #createWindowFor:..."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8597
    protocolsAtom := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8598
    deleteWindowAtom := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8599
    saveYourselfAtom := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8600
    quitAppAtom := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8601
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8602
    self initializeDeviceResourceTables.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8603
    self initializeScreenProperties.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8604
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8605
    self initializeDefaultValues.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8606
    self initializeSpecialFlags.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8607
    self initializeKeyboardMap.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8608
    self initializeDeviceSignals.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8609
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8610
    self initializeViewStyle.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8611
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8612
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8613
initializeModifierMappings
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8614
    "initialize keyboard modifiers.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8615
     We assume that mod1 are the META modifiers and mod2 are the ALT modifiers,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8616
     but if any of them contains the Num_Lock key, it is disregarded."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8617
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8618
    |map|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8619
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8620
    super initializeModifierMappings.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8621
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8622
    rawKeySymTranslation := RawKeySymTranslation.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8623
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8624
    map := self modifierMapping.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8625
    map isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8626
        "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8627
        "/ mhmh - a crippled Xlib which does not provide modifier mappings
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8628
        "/ setup some reasonable default. If that is not sufficient,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8629
        "/ you have to change things from your display.rc file.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8630
        "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8631
        altModifierMask := self modifier1Mask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8632
        metaModifierMask := self modifier2Mask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8633
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8634
        | mod symbolFromKeyCode nonNilOnes |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8635
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8636
        altModifierMask := 0.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8637
        metaModifierMask := 0.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8638
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8639
        symbolFromKeyCode := [:key | self symbolFromKeycode:key].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8640
        nonNilOnes := [:str | str notNil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8641
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8642
        mod := map at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8643
        mod notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8644
            shiftModifiers := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8645
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8646
        mod := map at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8647
        mod notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8648
            ctrlModifiers  := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8649
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8650
        mod := map at:4.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8651
        mod notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8652
            mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8653
            (mod includes:#'Num_Lock') ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8654
                metaModifiers := mod.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8655
                metaModifierMask := 1 bitShift:(4-1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8656
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8657
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8658
        mod := map at:5.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8659
        mod notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8660
            mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8661
            (mod includes:#'Num_Lock') ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8662
                altModifiers   := mod.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8663
                altModifierMask := 1 bitShift:(5-1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8664
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8665
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8666
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8667
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8668
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8669
     Display initializeModifierMappings
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8670
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8671
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8672
    "Modified: 1.12.1995 / 23:44:40 / stefan"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8673
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8674
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8675
initializeScreenBounds
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8676
    self isXineramaActive ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8677
        |rect|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8678
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8679
        self monitorBounds do:[:eachRect|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8680
            rect isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8681
                rect := eachRect.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8682
            ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8683
                rect := rect merge:eachRect.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8684
            ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8685
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8686
        width := rect width.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8687
        height := rect height.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8688
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8689
        "propagate possible size changes to our rottView"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8690
        rootView notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8691
            rootView initialize.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8692
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8693
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8694
        width := self queryWidth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8695
        height := self queryHeight.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8696
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8697
    widthMM := self queryWidthMM.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8698
    heightMM := self queryHeightMM.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8699
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8700
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8701
      Display initializeScreenBounds
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8702
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8703
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8704
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8705
initializeScreenProperties
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8706
    |masks|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8708
    super initializeScreenProperties.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8709
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8710
    hasShapeExtension := self queryShapeExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8711
    hasShmExtension := self querySHMExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8712
    hasDPSExtension := self queryDPSExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8713
    hasXVideoExtension := self queryXVideoExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8714
    hasMbufExtension := self queryMBUFExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8715
    hasPEXExtension := self queryPEXExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8716
    hasImageExtension := self queryXIEExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8717
    hasInputExtension := self queryXIExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8718
    hasXineramaExtension := self queryXineramaExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8719
    hasRenderExtension := self queryRenderExtension.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8720
    hasXftLibrary := self queryXftLibrary.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8721
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8722
    primaryAtom := self atomIDOf:#PRIMARY.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8723
    stringAtom := self atomIDOf:#STRING.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8724
    clipboardAtom := self atomIDOf:#CLIPBOARD.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8725
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8726
    altModifierMask := self modifier2Mask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8727
    metaModifierMask := self modifier1Mask.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8728
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8729
    screen := self queryDefaultScreen.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8730
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8731
    self initializeScreenBounds.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8732
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8733
    depth := self queryDepth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8734
    ncells := self queryCells.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8735
    blackpixel := self queryBlackPixel.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8736
    whitepixel := self queryWhitePixel.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8737
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8738
    monitorType := #unknown.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8739
    visualType := self queryDefaultVisualType.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8740
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8741
    hasColors := hasGreyscales := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8742
    (visualType == #StaticGray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8743
     or:[ visualType == #GrayScale]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8744
        hasColors := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8745
        monitorType := #monochrome.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8746
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8747
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8748
    ncells == 2 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8749
        hasColors := hasGreyscales := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8750
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8751
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8752
    masks := self queryRGBMasks.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8753
    redMask := masks at:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8754
    greenMask := masks at:2.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8755
    blueMask := masks at:3.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8756
    bitsPerRGB := masks at:4.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8757
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8758
    visualType == #TrueColor ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8759
        redShift := redMask lowBit - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8760
        greenShift := greenMask lowBit - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8761
        blueShift := blueMask lowBit - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8762
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8763
        bitsRed := redMask highBit - redMask lowBit + 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8764
        bitsGreen := greenMask highBit - greenMask lowBit + 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8765
        bitsBlue := blueMask highBit - blueMask lowBit + 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8766
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8767
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8768
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8769
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8770
    Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8771
    int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8772
    Visual *visual;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8773
    XVisualInfo viproto;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8774
    XVisualInfo *vip;                   /* returned info */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8775
    int maxRGBDepth, maxRGBADepth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8776
    int rgbRedMask, rgbGreenMask, rgbBlueMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8777
    int rgbaRedMask, rgbaGreenMask, rgbaBlueMask, rgbaAlphaMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8778
    int rgbVisualID, rgbaVisualID;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8779
    int nvi, i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8780
    char *type, *nm;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8781
    int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8782
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8783
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8784
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8785
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8786
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8787
         * look for RGB visual with the highest depth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8788
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8789
        nvi = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8790
        viproto.screen = scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8791
        vip = XGetVisualInfo (dpy, VisualScreenMask, &viproto, &nvi);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8792
        maxRGBDepth = maxRGBADepth = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8793
        for (i = 0; i < nvi; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8794
            int thisDepth = vip[i].depth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8795
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8796
            switch (vip[i].class) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8797
                case TrueColor:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8798
                    if (thisDepth > maxRGBDepth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8799
                        if (thisDepth <= 24) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8800
                            maxRGBDepth = thisDepth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8801
                            rgbRedMask = vip[i].red_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8802
                            rgbGreenMask = vip[i].green_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8803
                            rgbBlueMask = vip[i].blue_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8804
                            rgbVisualID = vip[i].visualid;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8805
                        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8806
                            if (thisDepth > maxRGBADepth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8807
                                // printf("found rgba visual!\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8808
                                maxRGBADepth = thisDepth;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8809
                                rgbaRedMask = vip[i].red_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8810
                                rgbaGreenMask = vip[i].green_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8811
                                rgbaBlueMask = vip[i].blue_mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8812
                                rgbaVisualID = vip[i].visualid;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8813
                            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8814
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8815
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8816
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8817
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8818
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8819
        if (vip) XFree ((char *) vip);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8820
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8821
        if (maxRGBDepth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8822
            __INST(rgbVisual) = __MKEXTERNALADDRESS(rgbVisualID); __STORESELF(rgbVisual);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8823
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8824
        if (maxRGBADepth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8825
            __INST(rgbaVisual) = __MKEXTERNALADDRESS(rgbaVisualID); __STORESELF(rgbaVisual);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8826
            if (!maxRGBDepth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8827
                __INST(rgbVisual) = __INST(rgbaVisual); __STORESELF(rgbVisual);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8828
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8829
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8830
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8831
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8832
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8833
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8834
initializeSpecialFlags
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8835
    "perform additional special server implementation flags"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8836
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8837
    "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8838
    "/ assume we have it ... (should check)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8839
    "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8840
    hasSaveUnder := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8841
    ignoreBackingStore := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8842
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8843
    (self serverVendor = 'X11/NeWS') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8844
        "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8845
        "/ this is a kludge around a bug in the X11/NeWS server,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8846
        "/ which does not correctly handle saveUnder
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8847
        "/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8848
        hasSaveUnder := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8849
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8850
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8851
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8852
initializeUniqueID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8853
    uniqueDeviceID isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8854
        uniqueDeviceID := UUID genUUID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8855
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8856
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8857
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8858
invalidateConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8859
    super invalidateConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8860
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8861
    "the new display may support a different set of fonts"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8862
    self flushListOfAvailableFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8863
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8864
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8865
openConnectionTo:dpyName
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8866
    "open a connection to some display;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8867
     return the displayId if ok, nil of not ok"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8868
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8869
%{ /* STACK:100000 */    /* XOpenDisplay() calls gethostbyname() */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8870
    Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8871
    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8872
    char *nm;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8873
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8874
    if (__isStringLike(dpyName))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8875
        nm = (char *) __stringVal(dpyName);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8876
    else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8877
        nm = NULL;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8878
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8879
    dpy = XOpenDisplay(nm);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8880
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8881
    if (dpy) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8882
        static int firstCall = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8883
        OBJ dpyID;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8884
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8885
        dpyID = __MKEXTERNALADDRESS(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8886
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8887
        if (firstCall) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8888
            firstCall = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8889
            XSetErrorHandler(__XErrorHandler__);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8890
            XSetIOErrorHandler(__XIOErrorHandler__);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8891
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8892
        RETURN (dpyID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8893
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8894
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8895
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8896
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8897
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8898
queryBlackPixel
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8899
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8900
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8901
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8902
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8903
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8904
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8905
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8906
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8907
        RETURN ( __MKSMALLINT(BlackPixel(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8908
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8909
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8910
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8911
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8912
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8913
     Display queryBlackPixel
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8914
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8915
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8916
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8917
queryCells
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8918
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8919
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8920
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8921
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8922
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8923
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8924
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8925
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8926
        RETURN ( __MKSMALLINT(DisplayCells(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8927
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8928
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8929
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8930
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8931
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8932
     Display queryCells
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8933
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8934
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8935
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8936
queryDPSExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8937
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8938
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8939
#ifdef DPS
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8940
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8941
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8942
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8943
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8944
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8945
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8946
        if (XQueryExtension(dpy, "DPSExtension", &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8947
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8948
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8949
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8950
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8951
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8952
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8953
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8954
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8955
     Display queryDPSExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8956
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8957
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8958
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8959
queryDefaultScreen
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8960
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8961
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8962
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8963
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8964
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8965
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8966
        RETURN ( __MKSMALLINT(DefaultScreen(dpy)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8967
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8968
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8969
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8970
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8971
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8972
     Display queryDefaultScreen
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8973
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8974
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8975
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8976
queryDefaultVisualType
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8977
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8978
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8979
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8980
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8981
        Visual *visual;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8982
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8983
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8984
        visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8985
        switch (visual->class) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8986
            case StaticGray:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8987
                RETURN ( @symbol(StaticGray) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8988
            case GrayScale:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8989
                RETURN ( @symbol(GrayScale) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8990
            case StaticColor:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8991
                RETURN ( @symbol(StaticColor) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8992
            case PseudoColor:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8993
                RETURN ( @symbol(PseudoColor) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8994
            case TrueColor:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8995
                RETURN ( @symbol(TrueColor) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8996
            case DirectColor:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8997
                RETURN ( @symbol(DirectColor) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8998
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  8999
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9000
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9001
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9002
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9003
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9004
     Display queryDefaultVisualType
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9005
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9006
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9007
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9008
queryDepth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9009
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9010
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9011
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9012
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9013
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9014
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9015
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9016
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9017
        RETURN ( __MKSMALLINT(DisplayPlanes(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9018
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9019
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9020
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9021
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9022
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9023
     Display queryDepth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9024
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9025
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9026
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9027
queryHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9028
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9029
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9030
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9031
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9032
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9033
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9034
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9035
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9036
        RETURN ( __MKSMALLINT(DisplayHeight(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9037
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9038
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9039
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9040
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9041
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9042
     Display queryHeight
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9043
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9044
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9045
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9046
queryHeightMM
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9047
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9048
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9049
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9050
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9051
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9052
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9053
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9054
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9055
        RETURN ( __MKSMALLINT(DisplayHeightMM(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9056
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9057
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9058
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9059
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9060
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9061
     Display queryHeightMM
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9062
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9063
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9064
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9065
queryMBUFExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9066
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9067
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9068
#ifdef MBUF
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9069
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9070
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9071
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9072
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9073
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9074
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9075
        if (XQueryExtension(dpy, "Multi-Buffering", &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9076
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9077
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9078
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9079
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9080
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9081
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9082
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9083
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9084
     Display queryMBUFExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9085
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9086
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9087
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9088
queryPEXExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9089
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9090
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9091
#ifdef PEX5
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9092
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9093
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9094
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9095
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9096
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9097
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9098
        if (XQueryExtension(dpy, PEX_NAME_STRING, &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9099
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9100
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9101
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9102
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9103
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9104
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9105
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9106
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9107
     Display queryPEXExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9108
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9109
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9110
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9111
queryRGBMasks
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9112
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9113
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9114
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9115
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9116
        Visual *visual;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9117
        OBJ redMask, greenMask, blueMask, bprgb;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9118
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9119
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9120
        visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9121
        redMask   = __MKSMALLINT(visual->red_mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9122
        greenMask = __MKSMALLINT(visual->green_mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9123
        blueMask  = __MKSMALLINT(visual->blue_mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9124
        bprgb  = __MKSMALLINT(visual->bits_per_rgb);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9125
        RETURN ( __ARRAY_WITH4(redMask, greenMask, blueMask, bprgb) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9126
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9127
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9128
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9129
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9130
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9131
     Display queryRGBMasks
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9132
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9133
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9134
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9135
queryRenderExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9136
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9137
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9138
#ifdef XRENDER
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9139
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9140
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9141
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9142
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9143
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9144
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9145
        if (XRenderQueryExtension (dpy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9146
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9147
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9148
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9149
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9150
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9151
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9152
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9153
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9154
     Display queryRenderExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9155
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9156
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9157
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9158
querySHMExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9159
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9160
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9161
#ifdef xxSHM
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9162
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9163
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9164
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9165
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9166
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9167
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9168
        if (XQueryExtension(dpy, "MIT_SHM", &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9169
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9170
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9171
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9172
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9173
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9174
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9175
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9176
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9177
     Display querySHMExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9178
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9179
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9180
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9181
queryShapeExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9182
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9183
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9184
#ifdef SHAPE
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9185
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9186
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9187
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9188
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9189
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9190
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9191
        if (XShapeQueryExtension(dpy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9192
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9193
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9194
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9195
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9196
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9197
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9198
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9199
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9200
     Display queryShapeExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9201
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9202
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9203
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9204
queryWhitePixel
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9205
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9206
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9207
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9208
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9209
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9210
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9211
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9212
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9213
        RETURN ( __MKSMALLINT(WhitePixel(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9214
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9215
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9216
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9217
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9218
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9219
     Display queryWhitePixel
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9220
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9221
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9222
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9223
queryWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9224
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9225
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9226
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9227
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9228
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9229
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9230
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9231
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9232
        RETURN ( __MKSMALLINT(DisplayWidth(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9233
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9234
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9235
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9236
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9237
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9238
     Display queryWidth
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9239
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9240
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9241
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9242
queryWidthMM
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9243
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9244
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9245
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9246
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9247
        int scr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9248
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9249
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9250
        scr = DefaultScreen(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9251
        RETURN ( __MKSMALLINT(DisplayWidthMM(dpy, scr)));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9252
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9253
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9254
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9255
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9256
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9257
     Display queryWidthMM
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9258
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9259
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9260
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9261
queryXIEExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9262
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9263
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9264
#ifdef XIE
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9265
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9266
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9267
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9268
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9269
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9270
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9271
        if (XQueryExtension(dpy, xieExtName, &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9272
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9273
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9274
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9275
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9276
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9277
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9278
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9279
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9280
     Display queryXIEExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9281
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9282
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9283
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9284
queryXIExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9285
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9286
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9287
#ifdef XI
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9288
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9289
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9290
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9291
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9292
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9293
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9294
        if (XQueryExtension(dpy, "XInputExtension", &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9295
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9296
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9297
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9298
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9299
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9300
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9301
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9302
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9303
     Display queryXIExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9304
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9305
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9306
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9307
queryXVideoExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9308
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9309
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9310
#ifdef XVIDEO
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9311
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9312
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9313
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9314
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9315
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9316
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9317
        if (XQueryExtension(dpy, "XVideo", &dummy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9318
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9319
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9320
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9321
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9322
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9323
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9324
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9325
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9326
     Display queryXVideoExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9327
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9328
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9329
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9330
queryXftLibrary
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9331
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9332
#ifndef XFT
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9333
    RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9334
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9335
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9336
    ^ self queryRenderExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9337
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9338
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9339
queryXineramaExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9340
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9341
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9342
#ifdef XINERAMA
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9343
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9344
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9345
        int dummy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9346
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9347
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9348
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9349
        if (XineramaQueryExtension (dpy, &dummy, &dummy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9350
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9351
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9352
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9353
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9354
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9355
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9356
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9357
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9358
     Display queryXineramaExtension
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9359
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9360
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9361
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9362
reinitialize
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9363
    preWaitAction notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9364
        Processor removePreWaitAction:preWaitAction.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9365
        preWaitAction := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9366
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9367
    virtualRootId := rootId := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9368
    selectionFetchers := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9369
    dispatchingExpose := nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9370
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9371
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9372
releaseDeviceResources
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9373
    preWaitAction notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9374
        Processor removePreWaitAction:preWaitAction.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9375
        preWaitAction := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9376
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9377
    selectionFetchers := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9378
    super releaseDeviceResources.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9379
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9380
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9381
!XWorkstation methodsFor:'keyboard mapping'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9382
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9383
altModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9384
    "return the mask (in motionEvents) for the alt-key modifier.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9385
     Notice: ST/X may use the left ALT key as CMD/Meta key,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9386
     therefore return a variable here, which can be changed during startup."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9387
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9388
    ^ altModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9389
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9390
    "Created: 23.3.1996 / 12:43:22 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9391
    "Modified: 23.3.1996 / 12:44:56 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9392
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9393
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9394
altModifierMask:aSmallInteger
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9395
    "define which key takes the role of an alt-key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9396
     By default, this is X's modifier1, which is the ALT key on
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9397
     most keyboards. However, there may be exceptions to this,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9398
     and the setting can be changed with:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9399
        Display altModifierMask:(Display modifier2Mask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9400
     Setting the mask to 0 disables the ALT key (in ST/X) altogether.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9401
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9402
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9403
    altModifierMask := aSmallInteger
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9404
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9405
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9406
ctrlModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9407
    "return the Xlib mask bit for the control modifier key"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9408
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9409
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9410
    RETURN (__MKSMALLINT(ControlMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9411
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9412
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9413
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9414
metaModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9415
    "return the mask (in motionEvents) for the meta-key modifier.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9416
     Notice: ST/X may use the left ALT key as CMD/Meta key,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9417
     therefore return a variable here, which can be changed during startup."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9418
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9419
    ^ metaModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9420
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9421
    "Created: 23.3.1996 / 12:43:39 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9422
    "Modified: 23.3.1996 / 12:45:09 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9423
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9424
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9425
metaModifierMask:aSmallInteger
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9426
    "define which key takes the role of a meta key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9427
     By default, this is X's modifier2, which is the 2nd ALT key on
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9428
     most keyboards (if present at all).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9429
     However, there may be exceptions to this, and the setting can
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9430
     be changed with:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9431
        Display metaModifierMask:(Display modifier1Mask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9432
     Setting the mask to 0 disables the META key (in ST/X) altogether.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9433
     As reported, some Xservers place the Meta-key onto NumLock,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9434
     and having NumLock enabled makes ST/X think, that meta is pressed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9435
     all the time. On those, you should disable the meta key by setting
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9436
     the mask to 0.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9437
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9438
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9439
    metaModifierMask := aSmallInteger
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9440
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9441
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9442
modifier1Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9443
    "return the Xlib mask bit for the 1st modifier key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9444
     See comment in altModifierMask: / metaModifierMask: for what
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9445
     this could be used."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9446
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9447
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9448
    RETURN (__MKSMALLINT(Mod1Mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9449
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9450
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9451
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9452
modifier2Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9453
    "return the Xlib mask bit for the 2nd modifier key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9454
     See comment in altModifierMask: / metaModifierMask: for what
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9455
     this could be used."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9456
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9457
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9458
    RETURN (__MKSMALLINT(Mod2Mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9459
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9460
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9461
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9462
modifier3Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9463
    "return the Xlib mask bit for the 3rd modifier key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9464
     See comment in altModifierMask: / metaModifierMask: for what
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9465
     this could be used."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9466
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9467
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9468
    RETURN (__MKSMALLINT(Mod3Mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9469
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9470
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9471
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9472
modifier4Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9473
    "return the Xlib mask bit for the 4th modifier key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9474
     See comment in altModifierMask: / metaModifierMask: for what
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9475
     this could be used."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9476
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9477
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9478
    RETURN (__MKSMALLINT(Mod4Mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9479
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9480
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9481
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9482
modifier5Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9483
    "return the Xlib mask bit for the 5th modifier key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9484
     See comment in altModifierMask: / metaModifierMask: for what
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9485
     this could be used."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9486
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9487
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9488
    RETURN (__MKSMALLINT(Mod5Mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9489
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9490
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9491
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9492
modifierMapping
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9493
    "Get the Modifier Mapping.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9494
     We return an array of arrays of keycodes"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9495
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9496
    |modifierKeyMap maxKeyPerMod ret nextKey|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9497
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9498
    modifierKeyMap := self rawModifierMapping.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9499
    modifierKeyMap isEmptyOrNil ifTrue:[^ nil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9500
    maxKeyPerMod := modifierKeyMap size // 8.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9501
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9502
    ret := Array new:8.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9503
    nextKey := 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9504
    1 to:8 do:[ :i |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9505
        (modifierKeyMap at:nextKey) ~= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9506
            |mod|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9507
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9508
            mod := OrderedCollection new:maxKeyPerMod.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9509
            modifierKeyMap from:nextKey to:(nextKey+maxKeyPerMod-1) do:[ :key |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9510
                key ~= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9511
                    mod add:key
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9512
                ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9513
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9514
            ret at:i put:mod asArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9515
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9516
        nextKey := nextKey+maxKeyPerMod.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9517
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9518
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9519
    ^ ret
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9520
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9521
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9522
     Display modifierMapping
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9523
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9524
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9525
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9526
     |mapping|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9527
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9528
     mapping := Display modifierMapping.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9529
     ^ mapping collect:[:eachRow |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9530
                             eachRow notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9531
                                 eachRow collect:[ :key | Display stringFromKeycode:key ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9532
                             ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9533
                                 nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9534
                             ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9535
                       ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9536
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9537
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9538
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9539
rawKeySymTranslation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9540
    "Get the raw keyboard mapping (maps some special X-keySyms to STX-internal names
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9541
     and can also be used to untranslate a stupid x-mapping (as on hpux)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9542
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9543
    ^ rawKeySymTranslation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9544
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9545
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9546
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9547
     Display rawKeySymTranslation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9548
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9549
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9550
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9551
rawModifierMapping
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9552
    "Get the raw Modifier Mapping."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9553
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9554
    |modifierKeyMap|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9555
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9556
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9557
    XModifierKeymap *modmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9558
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9559
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9560
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9561
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9562
        if ((modmap = XGetModifierMapping(dpy)) != 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9563
           modifierKeyMap = __BYTEARRAY_UNINITIALIZED_NEW_INT(modmap->max_keypermod * 8);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9564
           if (modifierKeyMap != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9565
                memcpy((char *)__ByteArrayInstPtr(modifierKeyMap)->ba_element,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9566
                       (char *)modmap->modifiermap, modmap->max_keypermod * 8);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9567
           }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9568
           XFreeModifiermap(modmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9569
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9570
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9571
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9572
    ^ modifierKeyMap
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9573
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9574
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9575
        Display rawModifierMapping
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9576
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9577
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9578
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9579
shiftModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9580
    "return the Xlib mask bit for the shift modifier key"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9581
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9582
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9583
    RETURN (__MKSMALLINT(ShiftMask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9584
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9585
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9586
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9587
superModifierMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9588
    "return the Xlib mask bit for the super modifier key"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9589
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9590
    ^ self modifier4Mask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9591
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9592
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9593
symbolFromKeycode:code
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9594
    "Get a KeySymbol (a smalltalk symbol) from the keycode."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9595
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9596
    |str|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9597
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9598
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9599
    KeySym keysym;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9600
    char *keystring;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9601
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9602
    if (ISCONNECTED && __isSmallInteger(code)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9603
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9604
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9605
// Our Windows Xlib does not support Xkb as of 2013-01
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9606
//        if ((keysym = XkbKeycodeToKeysym(dpy, __intVal(code), 0, 0)) != NoSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9607
        if ((keysym = XKeycodeToKeysym(dpy, __intVal(code), 0)) != NoSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9608
            && (keystring = XKeysymToString(keysym)) != 0)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9609
            str = __MKSYMBOL(keystring, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9610
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9611
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9612
    ^ str
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9613
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9614
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9615
        Display symbolFromKeycode:50
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9616
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9617
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9618
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9619
!XWorkstation methodsFor:'misc'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9620
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9621
beep
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9622
    "output an audible beep or bell"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9623
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9624
    UserPreferences current beepEnabled ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9625
        self beep:0 volume:50
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9626
    ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9627
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9628
    "Modified: / 3.12.1999 / 17:13:59 / ps"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9629
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9630
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9631
beep:aSymbolOrInteger volume:volumeInPercent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9632
    "output an audible beep. aSymbolOrInteger determines the sound, but is ignored here
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9633
     (kept for comaptibilty with WinWorkstation)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9634
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9635
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9636
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9637
    int volume;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9638
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9639
    if (__isSmallInteger(volumeInPercent)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9640
     && ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9641
        /* stupid: X wants -100 .. 100 and calls this percent */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9642
        volume = __intVal(volumeInPercent) * 2 - 100;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9643
        if (volume < -100) volume = -100;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9644
        else if (volume > 100) volume = 100;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9645
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9646
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9647
        XBell(myDpy, volume);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9648
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9649
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9650
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9651
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9652
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9653
buffered
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9654
    "buffer drawing - do not send it immediately to the display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9655
     This is the default anyway.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9656
     See #unBuffered for additional info."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9657
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9658
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9659
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9660
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9661
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9662
        XSynchronize(myDpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9663
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9664
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9665
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9666
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9667
     Display buffered
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9668
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9669
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9670
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9671
flush
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9672
    "send all buffered drawing to the display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9673
     This may be required to make certain, that all previous operations
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9674
     are really sent to the display before continuing. For example,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9675
     after a cursor-change with a followup long computation.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9676
     (otherwise, the cursor change request may still be in the output buffer)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9677
     See also #sync, which even waits until the request has been processed."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9678
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9679
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9680
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9681
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9682
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9683
        XFlush(myDpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9684
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9685
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9686
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9687
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9688
    operationsUntilFlush := maxOperationsUntilFlush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9689
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9690
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9691
flushDpsContext:aDPSContext
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9692
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9693
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9694
#ifdef DPS
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9695
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9696
        && __isExternalAddress(aDPSContext)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9697
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9698
        DPSFlushContext(__DPSContextVal(aDPSContext));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9699
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9700
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9701
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9702
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9703
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9704
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9705
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9706
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9708
flushIfAppropriate
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9709
    "flush the device, if necessary"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9710
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9711
    operationsUntilFlush notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9712
	operationsUntilFlush <= 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9713
	    self flush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9714
	    ^ true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9715
	] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9716
	    operationsUntilFlush := operationsUntilFlush - 1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9717
	].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9718
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9719
    ^ false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9720
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9721
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9722
primSync
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9723
    "send all buffered drawing to the display AND wait until the display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9724
     has finished drawing it.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9725
     This is almost never needed, except if you are about to read previously
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9726
     drawn pixels back from the display screen, or you want to wait for a beep
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9727
     to be finished. See also #flush."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9728
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9729
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9730
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9731
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9732
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9733
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9734
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9735
        XSync(myDpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9736
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9737
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9738
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9739
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9740
    operationsUntilFlush := maxOperationsUntilFlush.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9741
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9742
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9743
refreshKeyboardMapping:eB
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9744
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9745
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9746
    XMappingEvent *ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9747
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9748
    if (ISCONNECTED && __isByteArrayLike(eB)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9749
        ev = (XMappingEvent *)(__ByteArrayInstPtr(eB)->ba_element);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9750
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9751
        XRefreshKeyboardMapping(ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9752
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9753
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9754
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9755
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9756
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9757
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9758
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9759
roundTripTime
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9760
    "answer the round trip time in milliSeconds.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9761
     May be used to detect slow X11 connections"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9762
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9763
    self sync.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9764
    ^ Timestamp millisecondsToRun:[ self primSync ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9765
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9766
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9767
     Screen current roundTripTime
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9768
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9769
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9770
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9771
setInputFocusTo:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9772
    "set the focus to the view as defined by aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9773
     When released, return the focus to the root window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9774
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9775
"/    self setInputFocusTo:aWindowId revertTo:#parent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9776
    self setInputFocusTo:aWindowId revertTo:#root
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9777
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9778
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9779
setInputFocusTo:aWindowId revertTo:revertSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9780
    "set the focus to the view as defined by aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9781
     Passing nil set the focus to no window and lets the display discard all
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9782
     input until a new focus is set.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9783
     RevertSymbol specifies what should happen if the view becomes invisible;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9784
     passing one of #parent, #root or nil specifies that the focus should be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9785
     given to the parent view, the root view or no view."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9786
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9787
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9788
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9789
    int arg;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9790
    Window focusWindow;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9791
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9792
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9793
        if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9794
            focusWindow = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9795
        } else if (aWindowId == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9796
            focusWindow = None;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9797
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9798
            goto err;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9799
        if (revertSymbol == @symbol(parent))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9800
            arg = RevertToParent;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9801
        else if (revertSymbol == @symbol(root))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9802
            arg = RevertToPointerRoot;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9803
        else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9804
            arg = RevertToNone;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9805
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9806
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9807
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9808
        XSetInputFocus(myDpy, focusWindow, arg, CurrentTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9809
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9810
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9811
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9812
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9813
err:;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9814
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9815
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9816
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9817
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9818
sync
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9819
    "send all buffered drawing to the display AND wait until the display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9820
     has finished drawing it.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9821
     This is almost never needed, except if you are about to read previously
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9822
     drawn pixels back from the display screen, or you want to wait for a beep
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9823
     to be finished. See also #flush."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9824
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9825
    self primSync.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9826
    self dispatchPendingEvents.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9827
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9828
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9829
unBuffered
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9830
    "make all drawing be sent immediately to the display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9831
     This makes all graphics synchronous and turns off any buffering
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9832
     (i.e. each individual draw-request is sent immediately without
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9833
      packing multiple requests into a larger message buffer).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9834
     Be prepared, that this slows down graphics considerably.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9835
     However, it allows display errors to be handled immediately and
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9836
     may be useful if you get Xdisplay errors and want to find the request
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9837
     which was responsible for it. See also #buffered."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9838
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9839
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9840
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9841
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9842
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9843
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9844
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9845
        XSynchronize(myDpy, 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9846
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9847
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9848
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9849
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9850
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9851
     Display unBuffered
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9852
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9853
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9854
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9855
!XWorkstation methodsFor:'pointer stuff'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9856
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9857
anyButtonStateMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9858
    "return an integer for masking out any button from a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9859
     buttonStates value."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9860
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9861
    "/ should use ``Display buttonXMotionMask bitOr:....''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9862
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9863
    ^ 256 + 512 + 1024
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9864
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9865
    "Modified: 23.3.1996 / 12:41:33 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9866
    "Created: 23.3.1996 / 12:46:35 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9867
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9868
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9869
buttonStates
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9870
    "return an integer representing the state of the pointer buttons;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9871
     a one-bit in positions 0.. represent a pressed button.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9872
     See the button1Mask/button2Mask/button3Mask,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9873
     shiftMask/controlMask and modifierMask methods for the meaning of the bits."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9874
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9875
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9876
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9877
    Window w;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9878
    int screen = __intVal(__INST(screen));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9879
    Window rootRet, childRet;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9880
    int rootX, rootY, winX, winY;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9881
    unsigned int mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9882
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9883
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9884
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9885
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9886
        w = RootWindow(dpy, screen);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9887
        if (w) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9888
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9889
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9890
            XQueryPointer(dpy, w, &rootRet, &childRet,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9891
                                 &rootX, &rootY,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9892
                                 &winX, &winY,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9893
                                 &mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9894
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9895
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9896
            RETURN (__MKSMALLINT(mask));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9897
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9898
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9899
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9900
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9901
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9902
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9903
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9904
     Display buttonStates
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9905
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9906
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9907
    "is the control-key pressed ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9908
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9909
     Display buttonStates bitTest:(Display controlMask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9910
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9911
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9912
    "is the alt/meta-key pressed ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9913
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9914
     Display buttonStates bitTest:(Display altModifierMask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9915
     Display buttonStates bitTest:(Display metaModifierMask)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9916
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9917
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9918
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9919
leftButtonStateMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9920
    "return an integer for masking out the left button from a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9921
     buttonStates value"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9922
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9923
    "/ should use ``Display button1MotionMask''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9924
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9925
    ^ 256
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9926
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9927
    "Modified: 23.3.1996 / 12:41:33 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9928
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9929
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9930
middleButtonStateMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9931
    "return an integer for masking out the middle button from a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9932
     buttonStates value"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9933
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9934
    "/ should use ``Display button2MotionMask''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9935
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9936
    ^ 512
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9937
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9938
    "Modified: 23.3.1996 / 12:41:43 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9939
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9940
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9941
pointerPosition
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9942
    "return the current pointer position in (virtual) root-window coordinates"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9943
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9944
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9945
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9946
    |xpos ypos rootWindowId|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9947
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9948
    rootWindowId := self rootWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9949
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9950
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9951
    int screen = __intVal(__INST(screen));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9952
    Window rootRet, childRet;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9953
    int rootX, rootY, winX, winY;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9954
    unsigned int mask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9955
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9956
    if (ISCONNECTED && rootWindowId != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9957
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9958
        Window w = (Window)__externalAddressVal(rootWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9959
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9960
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9961
        XQueryPointer(dpy, w, &rootRet, &childRet,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9962
                              &rootX, &rootY,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9963
                              &winX, &winY,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9964
                              &mask);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9965
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9966
        xpos = __MKSMALLINT(rootX);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9967
        ypos = __MKSMALLINT(rootY);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9968
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9969
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9970
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9971
    xpos isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9972
        self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9973
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9974
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9975
    ^ xpos @ ypos
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9976
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9977
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9978
rightButtonStateMask
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9979
    "return an integer for masking out the right button from a
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9980
     buttonStates value"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9981
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9982
    "/ should use ``Display button3MotionMask''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9983
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9984
    ^ 1024
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9985
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9986
    "Modified: 23.3.1996 / 12:41:52 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9987
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9988
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9989
rootPositionOfLastEvent
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9990
    "return the position in root-window coordinates
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9991
     of the last button, key or pointer event"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9992
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9993
    ^ eventRootX @ eventRootY
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9994
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9995
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9996
setPointerPosition:newPosition in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9997
    "change the pointer position to a new position relative to the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9998
     given windows origin (which may be the rootWindow).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
  9999
     Be careful with this - its usually not very ergonomically
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10000
     to change the mousePointer position.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10001
     This interface is provided for special applications (presentation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10002
     playback) and should not be used in normal applications."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10003
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10004
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10005
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10006
    |xpos ypos|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10007
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10008
    xpos := newPosition x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10009
    ypos := newPosition y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10010
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10011
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10012
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10013
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10014
     && __bothSmallInteger(xpos, ypos)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10015
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10016
        Window w = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10017
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10018
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10019
        XWarpPointer(dpy,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10020
                     None,  /* src window */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10021
                     w,  /* dst window */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10022
                     0,  /* src_x */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10023
                     0,  /* src_y */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10024
                     0,  /* src_w */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10025
                     0,  /* src_h */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10026
                     __intVal(xpos),  /* dst_x */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10027
                     __intVal(ypos)   /* dst_y */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10028
                    );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10029
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10030
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10031
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10032
    ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10033
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10034
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10035
     Display setPointerPosition:1000@1000
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10036
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10037
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10038
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10039
!XWorkstation methodsFor:'private'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10040
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10041
addSelectionHandler:someone
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10042
    "register someone to be notified when the selection changes"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10043
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10044
    selectionHandlers isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10045
        selectionHandlers := IdentitySet new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10046
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10047
    selectionHandlers add:someone
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10048
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10049
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10050
findSelectionFetcher:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10051
    "find the SelectionFetcher that receives selection events for aDrawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10052
     Answer nil, if there is none"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10053
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10054
    selectionFetchers isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10055
        ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10056
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10057
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10058
    ^ selectionFetchers at:aDrawableId ifAbsent:[].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10059
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10060
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10061
registerSelectionFetcher:aSelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10062
    "register a SelectionFetcher that receives selection events for aDrawableId"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10063
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10064
    selectionFetchers isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10065
        selectionFetchers := Dictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10066
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10067
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10068
    selectionFetchers at:aSelectionFetcher drawableID put:aSelectionFetcher.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10069
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10070
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10071
removeSelectionHandler:someone
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10072
    "no longer tell someone about selection changes"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10073
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10074
    selectionHandlers notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10075
        selectionHandlers remove:someone ifAbsent:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10076
        selectionHandlers := selectionHandlers asNilIfEmpty
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10077
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10078
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10079
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10080
unregisterSelectionFetcher:aSelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10081
    "unregister a SelectionFetcher that received selection events for aDrawableId"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10082
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10083
    selectionFetchers removeKey:aSelectionFetcher drawableID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10084
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10085
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10086
!XWorkstation methodsFor:'properties'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10087
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10088
deleteProperty:propertyID for:aWindowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10089
    "delete a property in the XServer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10090
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10091
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10092
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10093
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10094
    if (ISCONNECTED && __isAtomID(propertyID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10095
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10096
        Atom prop;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10097
        Window window;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10098
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10099
        prop = __AtomVal(propertyID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10100
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10101
        if (__isExternalAddress(aWindowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10102
            window = __WindowVal(aWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10103
        } else if (aWindowID == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10104
            window = DefaultRootWindow(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10105
        } else if (__isInteger(aWindowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10106
            window = (Window)__unsignedLongIntVal(aWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10107
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10108
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10109
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10110
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10111
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10112
        XDeleteProperty(dpy, window, prop);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10113
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10114
        RETURN(true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10115
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10116
fail:;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10117
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10118
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10119
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10120
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10121
getProperty:propertySymbolOrAtomID from:aWindowOrWindowIDOrNil delete:doDelete
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10122
    "get a property as an association propertyType->propertyValue"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10123
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10124
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10125
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10126
    |val typeID propertyID windowID|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10127
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10128
    propertySymbolOrAtomID isString ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10129
        propertyID := self atomIDOf:propertySymbolOrAtomID create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10130
        propertyID isNil ifTrue:[^ nil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10131
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10132
        propertyID := propertySymbolOrAtomID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10133
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10134
    aWindowOrWindowIDOrNil isView ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10135
        windowID := aWindowOrWindowIDOrNil id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10136
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10137
        windowID := aWindowOrWindowIDOrNil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10138
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10139
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10140
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10141
    Window window;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10142
    Atom property;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10143
    char *cp, *cp2;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10144
    Atom actual_type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10145
    int actual_format;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10146
    unsigned long nitems, bytes_after, nread;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10147
    unsigned char *data;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10148
    int ok = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10149
#   define PROP_SIZE    2048
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10150
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10151
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10152
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10153
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10154
        if (__isAtomID(propertyID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10155
            property = __AtomVal(propertyID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10156
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10157
            if (__isExternalAddress(windowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10158
                window = __WindowVal(windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10159
            } else if (windowID == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10160
                window = DefaultRootWindow(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10161
            } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10162
                goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10163
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10164
            nread = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10165
            cp = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10166
#ifdef PROPERTY_DEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10167
            console_fprintf(stderr, "getProperty %x\n", property);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10168
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10169
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10170
            do {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10171
                int retVal;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10172
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10173
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10174
                retVal = XGetWindowProperty(dpy, window, property, nread/4, PROP_SIZE,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10175
                                            doDelete == true,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10176
                                            AnyPropertyType, &actual_type, &actual_format,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10177
                                            &nitems, &bytes_after, (unsigned char **)&data);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10178
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10179
                if (retVal != Success) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10180
#ifdef PROPERTY_DEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10181
                    console_fprintf(stderr, "- no success\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10182
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10183
                    ok = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10184
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10185
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10186
#ifdef PROPERTY_DEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10187
                console_fprintf(stderr, "- type:%x\n", actual_type);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10188
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10189
                nitems *= (actual_format / 8);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10190
                typeID = __MKATOMOBJ(actual_type);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10191
                if (! cp) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10192
                    cp = cp2 = (char *)malloc(nitems+bytes_after);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10193
                } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10194
                    cp2 = cp + nread;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10195
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10196
                if (! cp) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10197
                    XFree(data);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10198
                    goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10199
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10200
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10201
                nread += nitems;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10202
                bcopy(data, cp2, nitems);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10203
                XFree(data);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10204
#ifdef PROPERTY_DEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10205
                console_fprintf(stderr, "- <nitems:%d bytes_after:%d>\n", nitems, bytes_after);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10206
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10207
            } while (bytes_after > 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10208
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10209
            if (ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10210
                switch (actual_format) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10211
                case 32:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10212
                    val = __stArrayFromCUIntArray((unsigned int*)cp, nread/4);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10213
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10214
                case 16:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10215
                    val = __stArrayFromCUShortArray((unsigned short*)cp, nread/2);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10216
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10217
                case 8:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10218
                default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10219
                    if (actual_type == XA_STRING) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10220
                        val = __MKSTRING_L(cp, nread);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10221
                    } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10222
                        val = __MKBYTEARRAY(cp, nread);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10223
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10224
                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10225
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10226
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10227
            if (cp)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10228
                free(cp);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10229
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10230
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10231
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10232
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10233
    (typeID isNil or:[typeID == 0]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10234
        "typeID == 0 (None): The property does not exist in the specified window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10235
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10236
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10237
    ^ typeID->val
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10238
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10239
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10240
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10241
        getProperty:#'_NET_WM_ICON_GEOMETRY'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10242
        from:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10243
        delete:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10244
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10245
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10246
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10247
propertiesOf:aWindowOrWindowIDOrNil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10248
    "return a collection of all properties' atomIDs of a window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10249
     Returns the rootWindows props for a nil window argument."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10250
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10251
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10252
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10253
    |windowID atoms|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10254
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10255
    aWindowOrWindowIDOrNil isView ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10256
        windowID := aWindowOrWindowIDOrNil id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10257
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10258
        windowID := aWindowOrWindowIDOrNil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10259
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10260
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10261
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10262
    Window window;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10263
    Atom *atomListPtr;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10264
    int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10265
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10266
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10267
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10268
        int numProps = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10269
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10270
        if (__isExternalAddress(windowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10271
            window = __WindowVal(windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10272
        } else if (windowID == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10273
            window = DefaultRootWindow(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10274
        } else if (__isInteger(windowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10275
            window = (Window)__unsignedLongIntVal(windowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10276
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10277
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10278
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10279
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10280
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10281
        atomListPtr = XListProperties(dpy, window, &numProps);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10282
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10283
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10284
        if (atomListPtr == NULL) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10285
            RETURN (nil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10286
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10287
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10288
        atoms = __ARRAY_NEW_INT(numProps);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10289
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10290
        if (atoms == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10291
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10292
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10293
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10294
        for (i=0; i<numProps; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10295
            OBJ atm;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10296
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10297
            atm = __MKATOMOBJ(atomListPtr[i]);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10298
            __ArrayInstPtr(atoms)->a_element[i] = atm; __STORE(atoms, atm);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10299
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10300
        XFree(atomListPtr);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10301
        RETURN (atoms);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10302
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10303
fail: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10304
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10305
    ^ self primitiveFailed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10306
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10307
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10308
     Display propertiesOf:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10309
     Display propertiesOf:Transcript view id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10310
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10311
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10312
     (Display propertiesOf:nil) do:[:atm |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10313
        |v prop|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10314
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10315
        Transcript show:((Display atomName:atm) printStringLeftPaddedTo:5).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10316
        Transcript show:': '.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10317
        prop := Display getProperty:atm from:nil delete:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10318
        Transcript showCR:prop value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10319
     ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10320
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10321
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10322
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10323
setIcon:anIcon for:aWindowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10324
    |iconAtom typeAtom buffer iWidth iHeight|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10325
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10326
    iconAtom := self atomIDOf:#'_NET_WM_ICON' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10327
    iconAtom isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10328
        "/Hmm, no such property, not running under EWMH compliant WM?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10329
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10330
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10331
    typeAtom := self atomIDOf:#'CARDINAL' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10332
    typeAtom isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10333
        "/Hmm, no such property, not running under EWMH compliant WM?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10334
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10335
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10336
    iWidth  := anIcon width.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10337
    iHeight := anIcon height.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10338
    buffer := IntegerArray new:(iWidth*iHeight+2).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10339
    buffer at:1 put:iWidth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10340
    buffer at:2 put:iHeight.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10341
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10342
    self setProperty:iconAtom type:typeAtom value:buffer for:aWindowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10343
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10344
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10345
        Display setIcon:0 for:0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10346
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10347
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10348
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10349
setProperty:propertyID type:typeID value:anObject for:aWindowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10350
    "set a property in the XServer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10351
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10352
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10353
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10354
    |retval|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10355
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10356
    retval := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10357
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10358
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10359
    if (ISCONNECTED && __isAtomID(propertyID) && __isAtomID(typeID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10360
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10361
        Atom prop, type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10362
        Window window;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10363
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10364
        prop = __AtomVal(propertyID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10365
        type = __AtomVal(typeID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10366
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10367
        if (__isExternalAddress(aWindowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10368
            window = __WindowVal(aWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10369
        } else if (aWindowID == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10370
            window = DefaultRootWindow(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10371
        } else if (__isInteger(aWindowID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10372
            window = (Window)__unsignedLongIntVal(aWindowID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10373
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10374
            RETURN(false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10375
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10376
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10377
        retval = true;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10378
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10379
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10380
        if (__isInteger(anObject)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10381
            unsigned INT value = __longIntVal(anObject);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10382
            XChangeProperty(dpy, window, prop, type, 32,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10383
                            PropModeReplace,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10384
                            (unsigned char *)&value, 1);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10385
        } else if (__isByteArrayLike(anObject)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10386
            XChangeProperty(dpy, window, prop, type, 8,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10387
                            PropModeReplace,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10388
                            __byteArrayVal(anObject),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10389
                            __byteArraySize(anObject));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10390
        } else if (__isWords(anObject)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10391
            /* wordArray-like (16bit-string) object */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10392
            XChangeProperty(dpy, window, prop, type, 16,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10393
                            PropModeReplace,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10394
                            __stringVal(anObject),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10395
                            __wordArraySize(anObject));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10396
        } else if (__isIntegerArray(anObject)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10397
            /* array of atoms */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10398
            XChangeProperty(dpy, window, prop, type, 32,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10399
                            PropModeReplace,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10400
                            (char *)__integerArrayVal(anObject),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10401
                            __integerArraySize(anObject));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10402
        } else if (__isStringLike(anObject)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10403
            XChangeProperty(dpy, window, prop, type, 8,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10404
                            PropModeReplace,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10405
                            __stringVal(anObject),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10406
                            __stringSize(anObject));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10407
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10408
            retval = false;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10409
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10410
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10411
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10412
        DPRINTF(("changeProp win=%"_lx_" prop=%"_lx_" type=%"_lx_"\n", (INT)window, (INT)prop, (INT)type));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10413
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10414
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10415
    ^ retval
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10416
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10417
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10418
!XWorkstation methodsFor:'queries'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10419
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10420
defaultExtentForTopViews
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10421
    "redefined, to define the default extent for the default monitor"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10422
    |extent|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10423
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10424
    "the standard monitor is the first entry in monitorBounds"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10425
    extent := self monitorBounds first extent.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10426
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10427
    self isPDA ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10428
        ^ extent - (16 @ 20)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10429
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10430
    ^ extent * 2 // 3
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10431
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10432
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10433
isOpen
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10434
    "answer true, if device can be used"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10435
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10436
    ^ displayId notNil and:[hasConnectionBroken not].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10437
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10438
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10439
isXineramaActive
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10440
%{  /* NOCONTEXT */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10441
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10442
#ifdef XINERAMA
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10443
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10444
        Display *dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10445
        dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10446
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10447
        if (XineramaIsActive(dpy)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10448
            RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10449
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10450
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10451
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10452
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10453
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10454
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10455
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10456
     Display isXineramaActive
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10457
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10458
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10459
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10460
supportedClipboards
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10461
    "answer a collection of symbols with the supported clipboards.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10462
     X11 additionaly supports a buffer containing the currently selected text
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10463
     (in xterm) - the PRIMARY selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10464
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10465
    ^ #(clipboard selection)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10466
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10467
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10468
supportsUTF8WindowLabels
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10469
    "answer true, if window labels are to be utf-8 encoded"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10470
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10471
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10472
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10473
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10474
supportsVariableHeightFonts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10475
    "are fonts with variable height supported?"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10476
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10477
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10478
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10479
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10480
!XWorkstation methodsFor:'resources'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10481
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10482
atomIDOf:aStringOrSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10483
    "return an X11 atoms ID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10484
     This is highly X specific and only for local use (with selections).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10485
     The default is to create the atom, if it does not exist, in order to
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10486
     speed up future lookups"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10487
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10488
    ^ self atomIDOf:aStringOrSymbol create:true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10489
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10490
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10491
     Display atomIDOf:#'FACE_NAME'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10492
     Display atomIDOf:#'FULL_NAME'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10493
     Display atomIDOf:#DndProtocol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10494
     Display atomIDOf:#DndSelection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10495
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10496
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10497
    "Modified: 4.4.1997 / 13:38:48 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10498
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10499
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10500
atomIDOf:aStringOrSymbol create:create
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10501
    "return an Atoms ID given its name.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10502
     If it already exists, return its ID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10503
     If not and the create argument is true, it is created.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10504
     Otherwise, nil is returned.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10505
     This is highly X specific and only for local use (with selections)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10506
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10507
    |atomSymbol atom|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10508
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10509
    atomSymbol := aStringOrSymbol asSymbol.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10510
    (atoms notNil and:[(atom := atoms at:atomSymbol ifAbsent:nil) notNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10511
        ^ atom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10512
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10513
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10514
    atom := self primAtomIDOf:atomSymbol create:create.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10515
    atom notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10516
        atoms isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10517
            atoms := IdentityDictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10518
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10519
        atoms at:atomSymbol put:atom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10520
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10521
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10522
    ^ atom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10523
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10524
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10525
     Display atomIDOf:#'VT_SELECTION' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10526
     Display atomIDOf:#CLIPBOARD create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10527
     Display atomIDOf:'STRING' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10528
     Display atomIDOf:'PRIMARY' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10529
     Display atomIDOf:'blabla' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10530
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10531
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10532
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10533
atomName:anAtomID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10534
    "given an AtomID, return its name.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10535
     This is highly X specific and only for local use (with selections)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10536
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10537
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10538
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10539
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10540
    OBJ str;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10541
    char *name;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10542
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10543
    if (ISCONNECTED && __isAtomID(anAtomID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10544
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10545
        name = XGetAtomName(myDpy, __AtomVal(anAtomID));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10546
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10547
        if (name == 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10548
            RETURN (nil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10549
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10550
        str = __MKSTRING(name);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10551
        XFree(name);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10552
        RETURN ( str );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10553
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10554
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10555
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10556
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10557
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10558
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10559
     Display atomName:1    'PRIMARY'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10560
     Display atomName:130  '_DEC_DEVICE_FONTNAMES'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10561
     Display atomName:132  'FONTNAME_REGISTRY'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10562
     Display atomName:135 'FOUNDRY'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10563
     Display atomName:150  'CHARSET_REGISTRY'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10564
     Display atomName:151  'ISO8859'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10565
     Display atomName:152 'CHARSET_ENCODING'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10566
     Display atomName:154
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10567
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10568
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10569
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10570
getResource:name class:cls
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10571
    "access the displays resource database for a default value
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10572
     of name in a resource class.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10573
     This is highly X specific and  currently not used.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10574
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10575
     Notice:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10576
        we do not plan to use X's resources for ST/X's defaults,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10577
        styles or resources. This would make porting of applications
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10578
        to different platforms much more difficult (Windows has no resource
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10579
        database). If you stay within ST/X's resource files, these can be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10580
        easily transported to other platforms.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10581
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10582
     This method is provided for special applications which want to access
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10583
     existing X resources and are not planned to be ever ported to other
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10584
     platforms."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10585
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10586
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10587
    char *rslt;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10588
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10589
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10590
     && __isStringLike(name)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10591
     && __isStringLike(cls)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10592
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10593
        rslt = XGetDefault(myDpy, (char *) __stringVal(cls),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10594
                                  (char *) __stringVal(name));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10595
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10596
        RETURN (rslt ? __MKSTRING(rslt) : nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10597
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10598
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10599
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10600
    ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10601
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10602
    "if your ~/.Xdefaults contains an entry such as:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10603
        OpenWindows.Beep:       notices
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10604
     the following returns 'notices'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10605
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10606
         Display getResource:'Beep' class:'OpenWindows'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10607
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10608
     if your ~/.Xdefaults contains an entry such as:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10609
        *.beNiceToColormap:       false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10610
     the following return 'false'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10611
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10612
         Display getResource:'beNiceToColormap' class:'any'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10613
         Display getResource:'beNiceToColormap' class:''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10614
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10615
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10616
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10617
primAtomIDOf:aStringOrSymbol create:create
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10618
    "return an Atoms ID; if create is true, create it if not already present.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10619
     This is highly X specific and only for local use (with selections)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10620
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10621
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10622
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10623
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10624
    Atom prop;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10625
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10626
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10627
     && __isStringLike(aStringOrSymbol)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10628
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10629
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10630
        prop = XInternAtom(myDpy, __stringVal(aStringOrSymbol),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10631
                                  (create == true) ? False : True);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10632
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10633
        if (prop == None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10634
            RETURN (nil);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10635
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10636
        RETURN ( __MKATOMOBJ(prop) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10637
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10638
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10639
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10640
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10641
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10642
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10643
     Display primAtomIDOf:'VT_SELECTION' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10644
     Display primAtomIDOf:'CUT_BUFFER0' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10645
     Display primAtomIDOf:'STRING' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10646
     Display primAtomIDOf:'PRIMARY' create:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10647
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10648
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10649
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10650
!XWorkstation methodsFor:'retrieving pixels'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10651
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10652
getBitsFromId:aDrawableId x:srcx y:srcy width:w height:h into:imageBits
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10653
    "get bits from a drawable into the imageBits. The storage for the bits
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10654
     must be big enough for the data to fit. If ok, returns an array with some
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10655
     info and the bits in imageBits. The info contains the depth, bitOrder and
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10656
     number of bytes per scanline. The number of bytes per scanline is not known
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10657
     in advance, since the X-server is free to return whatever it thinks is a good padding."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10658
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10659
    |rawInfo info|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10660
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10661
    ((w <= 0) or:[h <= 0]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10662
        self primitiveFailed.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10663
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10664
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10665
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10666
    rawInfo := Array new:8.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10667
                  "1 -> bit order"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10668
                  "2 -> depth"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10669
                  "3 -> bytes_per_line"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10670
                  "4 -> byte_order"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10671
                  "5 -> format"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10672
                  "6 -> bitmap_unit"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10673
                  "7 -> bitmap_pad"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10674
                  "8 -> bits_per_pixel"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10675
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10676
    "/ had to extract the getPixel call into a separate method, to specify
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10677
    "/ unlimitedStack (some implementations use alloca and require huge amounts
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10678
    "/ of temporary stack space
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10679
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10680
    (self primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:rawInfo) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10681
        info := IdentityDictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10682
        info at:#bitOrder put:(rawInfo at:1).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10683
        info at:#depth put:(rawInfo at:2).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10684
        info at:#bytesPerLine put:(rawInfo at:3).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10685
        info at:#byteOrder put:(rawInfo at:4).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10686
        info at:#format put:(rawInfo at:5).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10687
        info at:#bitmapUnit put:(rawInfo at:6).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10688
        info at:#bitmapPad put:(rawInfo at:7).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10689
        info at:#bitsPerPixel put:(rawInfo at:8).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10690
        ^ info
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10691
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10692
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10693
     some error occured - either args are not smallintegers, imageBits is not a ByteArray
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10694
     or is too small to hold the bits
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10695
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10696
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10697
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10698
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10699
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10700
getPixelX:x y:y from:aDrawableId with:dummyGCId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10701
    "return the pixel value at x/y; coordinates start at 0/0 for the upper left.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10702
     Nil is returned for invalid coordinates or if any other problem arises."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10703
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10704
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10705
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10706
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10708
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10709
    XImage *img;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10710
    int ret;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10711
    int xpos, ypos;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10712
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10713
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10714
     && __isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10715
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10716
        xpos = __intVal(x);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10717
        ypos = __intVal(y);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10718
        if ((xpos < 0) || (ypos < 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10719
            RETURN ( __MKSMALLINT(0) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10720
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10721
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10722
        img = XGetImage(myDpy, win, xpos, ypos, 1, 1, (unsigned)~0, ZPixmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10723
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10724
        if (img != 0) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10725
            ret = XGetPixel(img, 0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10726
            XDestroyImage(img);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10727
            RETURN (  __MKSMALLINT(ret) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10728
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10729
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10730
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10731
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10732
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10733
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10734
primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:info
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10735
    "since XGetImage may allocate huge amount of stack space
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10736
     (some implementations use alloca), this must run with unlimited stack."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10737
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10738
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10739
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10740
%{  /* UNLIMITEDSTACK */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10741
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10742
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10743
    XImage *image = (XImage *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10744
    int pad, bytes_per_line, numBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10745
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10746
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10747
     && __isExternalAddress(aDrawableId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10748
     && __bothSmallInteger(srcx, srcy)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10749
     && __bothSmallInteger(w, h)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10750
     && __isArray(info)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10751
     && __isByteArray(imageBits)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10752
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10753
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10754
        win = __WindowVal(aDrawableId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10755
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10756
        image = XGetImage(dpy, win, __intVal(srcx), __intVal(srcy),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10757
                                    __intVal(w), __intVal(h),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10758
                                    (unsigned)AllPlanes, ZPixmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10759
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10760
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10761
        if (! image) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10762
            RETURN ( false );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10763
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10764
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10765
        pad = image->bitmap_pad;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10766
#ifdef SUPERDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10767
        console_printf("pad:%d depth:%d\n", image->bitmap_pad, image->depth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10768
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10769
        switch (image->depth) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10770
            case 1:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10771
            case 2:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10772
            case 4:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10773
            case 8:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10774
            case 16:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10775
            case 24:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10776
            case 32:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10777
                numBytes = image->bytes_per_line * image->height;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10778
                break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10779
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10780
            default:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10781
                /* unsupported depth ? */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10782
                console_fprintf(stderr, "possibly unsupported depth:%d in primGetBits\n", image->depth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10783
                numBytes = image->bytes_per_line * image->height;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10784
                break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10785
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10786
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10787
#ifdef SUPERDEBUG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10788
        console_printf("bytes need:%d bytes given:%d\n", numBytes, __byteArraySize(imageBits));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10789
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10790
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10791
        if (numBytes > __byteArraySize(imageBits)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10792
            /* imageBits too small */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10793
            console_fprintf(stderr, "Workstation [warning]: byteArray too small in primGetBits\n");
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10794
            console_fprintf(stderr, "  bytes need:%d given:%d\n", numBytes, (int)__byteArraySize(imageBits));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10795
            console_fprintf(stderr, "  pad:%d depth:%d imgBytesPerLine:%d\n",
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10796
                                image->bitmap_pad, image->depth, image->bytes_per_line);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10797
            goto fail;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10798
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10799
        if (image->bitmap_bit_order == MSBFirst)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10800
            __ArrayInstPtr(info)->a_element[0] = @symbol(msbFirst);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10801
        else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10802
            __ArrayInstPtr(info)->a_element[0] = @symbol(lsbFirst);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10803
        __ArrayInstPtr(info)->a_element[1] = __MKSMALLINT(image->depth);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10804
        __ArrayInstPtr(info)->a_element[2] = __MKSMALLINT(image->bytes_per_line);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10805
        if (image->byte_order == MSBFirst)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10806
            __ArrayInstPtr(info)->a_element[3] = @symbol(msbFirst);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10807
        else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10808
            __ArrayInstPtr(info)->a_element[3] = @symbol(lsbFirst);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10809
        if (image->format == XYBitmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10810
            __ArrayInstPtr(info)->a_element[4] = @symbol(XYBitmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10811
        else if (image->format == XYPixmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10812
            __ArrayInstPtr(info)->a_element[4] = @symbol(XYPixmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10813
        else if (image->format == ZPixmap)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10814
            __ArrayInstPtr(info)->a_element[4] = @symbol(ZPixmap);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10815
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10816
        __ArrayInstPtr(info)->a_element[5] = __MKSMALLINT(image->bitmap_unit);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10817
        __ArrayInstPtr(info)->a_element[6] = __MKSMALLINT(image->bitmap_pad);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10818
        __ArrayInstPtr(info)->a_element[7] = __MKSMALLINT(image->bits_per_pixel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10819
        bcopy(image->data, __ByteArrayInstPtr(imageBits)->ba_element, numBytes);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10820
        XDestroyImage(image);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10821
        RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10822
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10823
fail:
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10824
    if (image) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10825
        XDestroyImage(image);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10826
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10827
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10828
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10829
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10830
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10831
!XWorkstation methodsFor:'selection fetching'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10832
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10833
getClipboardObjectFor:drawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10834
    "get the object selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10835
     Returns nil, if no selection is available.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10836
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10837
     Smalltalk puts ST_OBJECT only into the CLIPBOARD"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10838
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10839
    |selectionOwnerWindowId selection|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10840
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10841
    selectionOwnerWindowId := self getSelectionOwnerOf:clipboardAtom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10842
    selectionOwnerWindowId isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10843
        "no selection. There is the possibilty that one of our (modal)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10844
         views has been closed. Get the selection from the copyBuffer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10845
        ^ copyBuffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10846
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10847
    selectionOwnerWindowId = selectionOwner ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10848
        "I still hold the selection, so return my locally buffered data"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10849
        ^ copyBuffer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10850
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10851
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10852
    drawableId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10853
        "sorry, cannot fetch a selection, if there is no drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10854
         Should I borrow a drawableId from another window?"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10855
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10856
        selection := SelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10857
            requestSelection:clipboardAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10858
            type:(self atomIDOf:#'ST_OBJECT')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10859
            onDevice:self for:drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10860
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10861
        "/ should not happen
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10862
false ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10863
        "/ cg: disabled the code below: I don't want any string here (when asking for an object)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10864
        selection isEmptyOrNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10865
            selection := SelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10866
                requestSelection:clipboardAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10867
                type:(self atomIDOf:#'UTF8_STRING')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10868
                onDevice:self for:drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10869
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10870
            selection isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10871
                selection := SelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10872
                    requestSelection:clipboardAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10873
                    type:(self atomIDOf:#STRING)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10874
                    onDevice:self for:drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10875
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10876
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10877
].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10878
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10879
    selection isEmptyOrNil ifTrue:[ ^ copyBuffer ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10880
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10881
    ^ selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10882
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10883
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10884
       Display getClipboardObjectFor:Transcript id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10885
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10886
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10887
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10888
getClipboardText:selectionBufferSymbol for:drawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10889
    "get the text selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10890
     Returns nil, if no selection is available"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10891
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10892
    |selectionId selectionOwnerWindowId selection|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10893
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10894
    selectionBufferSymbol == #selection ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10895
        selectionId := primaryAtom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10896
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10897
        selectionId := clipboardAtom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10898
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10899
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10900
    selectionOwnerWindowId := self getSelectionOwnerOf:selectionId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10901
    selectionOwnerWindowId isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10902
        "no selection. There is the possibilty that one of our (modal)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10903
         views has been closed. Get the selection from the copyBuffer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10904
        ^ self copyBufferAsString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10905
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10906
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10907
    selectionOwnerWindowId = selectionOwner ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10908
        "I still hold the selection, so return my locally buffered data"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10909
        "JV@2012-04-02: Added support for PRIMARY/SELECTION buffers."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10910
        ^ selectionId == primaryAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10911
            self primaryBufferAsString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10912
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10913
            self copyBufferAsString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10914
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10915
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10916
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10917
    drawableId notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10918
        "sorry, cannot fetch a selection, if there is no drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10919
         Should I borrow a drawableId from another window?"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10920
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10921
        selection := SelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10922
            requestSelection:selectionId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10923
            type:(self atomIDOf:#'UTF8_STRING')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10924
            onDevice:self for:drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10925
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10926
        selection isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10927
            selection := SelectionFetcher
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10928
                requestSelection:selectionId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10929
                type:(self atomIDOf:#STRING)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10930
                onDevice:self for:drawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10931
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10932
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10933
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10934
    ^ selection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10935
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10936
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10937
       Display getTextSelection:#clipboard for:Transcript id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10938
       Display getTextSelection:#selection for:Transcript id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10939
     "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10940
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10941
    "Modified: / 02-04-2012 / 10:34:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10942
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10943
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10944
!XWorkstation methodsFor:'selection sending'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10945
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10946
selectionBuffer:bufferGetSelector as:aTargetAtomID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10947
    "convert the current selection to the format defined by aTargetAtom.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10948
     Answer an association with the type of converted selection (an atomID)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10949
     and the converted selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10950
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10951
    |buffer bufferAsString|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10952
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10953
    buffer := self perform:bufferGetSelector.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10954
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10955
    (aTargetAtomID == (self atomIDOf:#'ST_OBJECT')) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10956
        "/ 'st-object' printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10957
        "send the selection in binaryStore format"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10958
        "require libboss to be loaded"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10959
        (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10960
            'XWorkstation: cannot use binary store for copy buffer (libboss missing)' errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10961
            ^ nil -> nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10962
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10963
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10964
        [
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10965
            ^ aTargetAtomID -> (buffer binaryStoreBytes).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10966
        ] on:Error do:[:ex|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10967
            'XWorkstation: error on binary store of copy buffer: ' infoPrint.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10968
            ex description infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10969
            ^ nil -> nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10970
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10971
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10972
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10973
    bufferAsString := self class bufferAsString:buffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10974
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10975
    (aTargetAtomID == (self atomIDOf:#STRING)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10976
     or:[aTargetAtomID == (self atomIDOf:#'text/plain')]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10977
    ) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10978
        "/ 'string' printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10979
        "the other view wants the selection as string"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10980
        ^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10981
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10982
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10983
    (aTargetAtomID == (self atomIDOf:#UTF8_STRING)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10984
     or:[aTargetAtomID == (self atomIDOf:#'text/plain;codeset=utf-8')]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10985
    ) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10986
        "/ 'utf string' printCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10987
        "the other view wants the selection as utf8 string"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10988
        ^ aTargetAtomID -> (bufferAsString utf8Encoded).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10989
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10990
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10991
    aTargetAtomID == (self atomIDOf:#LENGTH) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10992
        "the other one wants to know the size of our selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10993
         LENGTH is deprecated, since we do not know how the selection is
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10994
         going to be converted. The client must not rely on the length returned"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10995
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10996
        ^ (self atomIDOf:#INTEGER) -> (bufferAsString size).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10997
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10998
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 10999
    "we do not support the requestet target type"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11000
    ^ nil -> nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11001
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11002
    "Modified: / 23-08-2006 / 15:56:08 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11003
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11004
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11005
setClipboardObject:anObject owner:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11006
    "set the object selection, and make aWindowId be the owner.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11007
     This can be used by other Smalltalk(X) applications only.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11008
     We set only the CLIPBOARD selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11009
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11010
    clipboardSelectionTime := lastEventTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11011
    self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11012
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11013
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11014
setClipboardText:aString owner:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11015
    "set the text selection, and make aWindowId be the owner.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11016
     This can be used by any other X application.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11017
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11018
     We set both the PRIMARY and CLIPBOARD, so that you can paste
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11019
     into xterm."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11020
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11021
    clipboardSelectionTime := primarySelectionTime := lastEventTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11022
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11023
    self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11024
    self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11025
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11026
    "Modified: / 17.6.1998 / 19:48:54 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11027
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11028
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11029
setPrimaryText:aString owner:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11030
    "set the PRIMARY selection, and make aWindowId be the owner.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11031
     This can be used by any other X application when middle-click
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11032
     pasting. X Window specific."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11033
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11034
    primarySelectionTime := lastEventTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11035
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11036
    self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11037
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11038
    "Created: / 27-03-2012 / 14:16:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11039
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11040
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11041
supportedTargetAtoms
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11042
    "answer an integer array containing the list of supported targets
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11043
     i.e. supported clipboard formats"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11044
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11045
    "Note: some sender code assumes that ST_OBJECT is first"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11046
    ^ #(ST_OBJECT STRING UTF8_STRING TIMESTAMP TARGETS LENGTH
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11047
      #'text/plain' #'text/plain;codeset=utf-8'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11048
    ) collect:[:eachTargetSymbol|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11049
            self atomIDOf:eachTargetSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11050
        ] as:IntegerArray.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11051
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11052
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11053
!XWorkstation methodsFor:'selections-basic'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11054
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11055
getSelectionOwnerOf:selectionAtomSymbolOrID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11056
    "get the owner of a selection, aDrawableID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11057
     Answer nil, if there is no owner"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11058
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11059
    <context:#return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11060
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11061
    |selectionAtomID|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11062
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11063
    selectionAtomSymbolOrID isString ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11064
        selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11065
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11066
        selectionAtomID := selectionAtomSymbolOrID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11067
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11068
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11069
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11070
    Window window;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11071
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11072
    if (__isAtomID(selectionAtomID) && ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11073
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11074
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11075
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11076
        window = XGetSelectionOwner(dpy, __AtomVal(selectionAtomID));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11077
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11078
        RETURN ((window == None) ? nil : __MKEXTERNALADDRESS(window));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11079
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11080
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11081
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11082
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11083
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11084
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11085
requestSelection:selectionID type:typeID for:aWindowId intoProperty:propertyID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11086
    "ask the server to send us the selection - the view with id aWindowID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11087
     will later receive a SelectionNotify event for it (once the Xserver replies
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11088
     with the selections value)."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11089
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11090
    <context:#return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11091
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11092
    |anIntegerTimestamp|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11093
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11094
    anIntegerTimestamp := lastEventTime.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11095
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11096
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11097
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11098
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11099
     && __isAtomID(typeID)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11100
     && __isAtomID(propertyID)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11101
     && __isAtomID(selectionID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11102
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11103
        Window w;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11104
        Time time;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11105
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11106
        if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11107
            w = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11108
        } else if (aWindowId == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11109
            w = (Window)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11110
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11111
            goto err;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11112
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11113
        if (anIntegerTimestamp == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11114
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11115
             * the ICCCM convention says: you should set the time to the time when
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11116
             * the selection was requested and not to CurrentTime
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11117
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11118
            time = CurrentTime;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11119
        } else if (__isInteger(anIntegerTimestamp)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11120
            time = __unsignedLongIntVal(anIntegerTimestamp);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11121
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11122
            goto err;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11123
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11124
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11125
        XConvertSelection(dpy, __AtomVal(selectionID), __AtomVal(typeID),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11126
                               __AtomVal(propertyID), w, time);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11127
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11128
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11129
        RETURN (true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11130
err:;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11131
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11132
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11133
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11134
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11135
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11136
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11137
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11138
        requestSelection:(Display atomIDOf:'PRIMARY')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11139
        property:(Display atomIDOf:'VT_SELECTION')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11140
        type:(Display atomIDOf:'STRING')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11141
        for:Transcript id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11142
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11143
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11144
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11145
        requestSelection:(Display atomIDOf:'PRIMARY')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11146
        property:(Display atomIDOf:'VT_SELECTION')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11147
        type:(Display atomIDOf:'C_STRING')
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11148
        for:Transcript id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11149
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11150
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11151
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11152
sendNotifySelection:selectionID property:propertyID target:targetID time:aTime to:requestorID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11153
    "send a selectionNotify back from a SelectionRequest.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11154
     PropertyID should be the same as requested  or nil, if the selection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11155
     could not be converted.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11156
     TargetId should be the same as requested.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11157
     Time should be the time when the selection has been acquired"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11158
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11159
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11160
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11161
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11162
        && (__isAtomID(propertyID) || propertyID == nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11163
        && __isAtomID(targetID) && __isAtomID(selectionID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11164
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11165
        XEvent ev;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11166
        Window requestor;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11167
        Status result;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11168
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11169
        if (__isExternalAddress(requestorID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11170
            requestor = __WindowVal(requestorID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11171
        } else if (__isSmallInteger(requestorID)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11172
            requestor = (Window)__smallIntegerVal(requestorID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11173
        } else if (requestorID == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11174
            requestor = DefaultRootWindow(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11175
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11176
            requestor = (Window)__unsignedLongIntVal(requestorID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11177
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11178
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11179
        ev.xselection.type = SelectionNotify;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11180
        ev.xselection.display = dpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11181
        ev.xselection.selection = __AtomVal(selectionID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11182
        ev.xselection.target = __AtomVal(targetID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11183
        ev.xselection.requestor = requestor;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11184
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11185
        if (__isExternalAddress(aTime)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11186
            ev.xselection.time = (INT)(__externalAddressVal(aTime));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11187
        } else if (__isSmallInteger(aTime)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11188
            ev.xselection.time = __smallIntegerVal(aTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11189
        } else if (aTime == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11190
            ev.xselection.time = CurrentTime;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11191
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11192
            ev.xselection.time = (INT)__unsignedLongIntVal(aTime);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11193
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11194
#if 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11195
        console_printf("ev.xselection.selection: %x\n", ev.xselection.selection);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11196
        console_printf("ev.xselection.target: %x\n", ev.xselection.target);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11197
        console_printf("ev.xselection.requestor: %x\n", ev.xselection.requestor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11198
        console_printf("ev.xselection.time: %x\n", ev.xselection.time);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11199
        console_printf("requestor: %x\n", requestor);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11200
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11201
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11202
        /* send nil property if selection cannot be converted */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11203
        if (propertyID == nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11204
            ev.xselection.property = None;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11205
        else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11206
            ev.xselection.property = __AtomVal(propertyID);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11207
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11208
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11209
        DPRINTF(("sending SelectionNotify sel=%"_lx_" prop=%"_lx_" target=%"_lx_" requestor=%"_lx_" to %"_lx_"\n",
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11210
                (INT)ev.xselection.selection,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11211
                (INT)ev.xselection.property,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11212
                (INT)ev.xselection.target,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11213
                (INT)ev.xselection.requestor,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11214
                (INT)requestor));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11215
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11216
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11217
        result = XSendEvent(dpy, requestor, False, 0 , &ev);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11218
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11219
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11220
        if ((result == BadValue) || (result == BadWindow)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11221
            DPRINTF(("bad status\n"));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11222
            RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11223
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11224
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11225
        XFlush(dpy);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11226
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11227
        RETURN (true)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11228
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11229
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11230
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11231
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11232
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11233
    "Modified: / 17.6.1998 / 20:23:20 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11234
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11235
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11236
setSelectionOwner:aWindowId of:selectionAtomSymbolOrID time:anIntegerTimestamp
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11237
    "set the owner of a selection; return false if failed"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11238
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11239
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11240
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11241
    |selectionAtomID|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11242
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11243
    "store the current owner of the selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11244
     If we still own the selection on paste,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11245
     we can avoid the X11 overhead"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11246
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11247
    selectionOwner := aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11248
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11249
    selectionAtomSymbolOrID isString ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11250
        selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11251
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11252
        selectionAtomID := selectionAtomSymbolOrID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11253
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11254
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11255
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11256
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11257
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11258
    if (__isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11259
     && __isAtomID(selectionAtomID)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11260
     && ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11261
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11262
        Time time;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11263
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11264
        win = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11265
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11266
        if (anIntegerTimestamp == nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11267
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11268
             * the ICCCM convention says: you should set the time to the time when
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11269
             * the selection was acquired and not to CurrentTime
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11270
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11271
            time = CurrentTime;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11272
        } else if (__isInteger(anIntegerTimestamp)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11273
            time = __unsignedLongIntVal(anIntegerTimestamp);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11274
        } else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11275
            goto err;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11276
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11277
        DPRINTF(("setOwner prop=%"_lx_" win=%"_lx_"\n", (INT)__AtomVal(selectionAtomID), (INT)win));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11278
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11279
        XSetSelectionOwner(dpy, __AtomVal(selectionAtomID), win, time);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11280
        RETURN (self);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11281
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11282
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11283
err:;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11284
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11285
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11286
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11287
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11288
!XWorkstation methodsFor:'window queries'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11289
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11290
allChildIdsOf:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11291
    "return all children-ids of the given window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11292
     Allows for all windows to be enumerated, if we start at the root."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11293
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11294
    |childIDs allChildIDs|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11295
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11296
    allChildIDs := OrderedCollection new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11297
    childIDs := self childIdsOf:aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11298
    childIDs notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11299
        allChildIDs addAll:childIDs.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11300
        childIDs do:[:eachChildId |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11301
            allChildIDs addAll:(self allChildIdsOf:eachChildId).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11302
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11303
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11304
    ^ allChildIDs
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11305
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11306
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11307
     Display allChildIdsOf:(Display rootWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11308
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11309
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11310
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11311
     |deviceIDAtom uuidAtom|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11312
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11313
     deviceIDAtom := (Display atomIDOf:#'STX_DEVICE_ID').
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11314
     uuidAtom     := (Display atomIDOf:#'UUID').
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11315
     (Display allChildIdsOf:(Display rootWindowId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11316
        select:[:id |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11317
            |uuid|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11318
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11319
            Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11320
                getProperty:deviceIDAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11321
                from:id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11322
                delete:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11323
                into:[:type :value |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11324
                    type == uuidAtom ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11325
                        uuid := UUID fromBytes:value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11326
                    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11327
                ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11328
            uuid notNil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11329
        ]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11330
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11331
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11332
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11333
childIdsOf:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11334
    "return all children-ids of the given window. Allows for all windows to be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11335
     enumerated, if we start at the root."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11336
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11337
    |childIdArray|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11338
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11339
    OBJ id;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11340
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11341
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11342
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11343
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11344
        Window win = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11345
        Window rootReturn, parentReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11346
        Window* children = (Window *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11347
        unsigned int numChildren;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11348
        int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11349
        int rslt;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11350
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11351
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11352
        rslt = XQueryTree(dpy, win,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11353
                       &rootReturn, &parentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11354
                       &children, &numChildren);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11355
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11356
        if (rslt) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11357
            childIdArray = __ARRAY_NEW_INT(numChildren);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11358
            if (childIdArray != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11359
                for (i=0; i < numChildren; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11360
                    if (children[i]) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11361
                        OBJ childId;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11362
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11363
                        childId = __MKEXTERNALADDRESS(children[i]);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11364
                        __ArrayInstPtr(childIdArray)->a_element[i] = childId;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11365
                        __STORE(childIdArray, childId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11366
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11367
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11368
                if (children) XFree(children);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11369
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11370
            RETURN (childIdArray);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11371
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11372
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11373
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11374
    ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11375
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11376
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11377
      Display childIdsOf:(Display rootWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11378
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11379
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11380
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11381
realRootWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11382
    "return the id of the real root window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11383
     This may not be the window you see as background,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11384
     since some window managers install a virtual root window on top
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11385
     of it. Except for very special cases, use #rootWindowId, which takes
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11386
     care of any virtual root."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11387
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11388
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11389
    int screen = __intVal(__INST(screen));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11390
    Window root;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11391
    OBJ id;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11392
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11393
    if (__INST(rootId) != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11394
        RETURN (__INST(rootId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11395
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11396
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11397
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11398
        root = RootWindow(myDpy, screen);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11399
        if (! root) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11400
            id = nil;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11401
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11402
            id = __MKEXTERNALADDRESS(root); __INST(rootId) = id; __STORE(self, id);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11403
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11404
        RETURN (id);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11405
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11406
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11407
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11408
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11409
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11410
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11411
      Display rootWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11412
      Display realRootWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11413
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11414
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11415
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11416
rootWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11417
    "return the id of the root window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11418
     This is the window you see as background,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11419
     however, it may or may not be the real physical root window,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11420
     since some window managers install a virtual root window on top
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11421
     of the real one. If this is the case, that views id is returned here."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11422
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11423
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11424
    int screen = __intVal(__INST(screen));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11425
    Window rootWin, vRootWin = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11426
    OBJ id;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11427
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11428
    if (__INST(virtualRootId) != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11429
        RETURN (__INST(virtualRootId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11430
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11431
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11432
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11433
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11434
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11435
        rootWin = RootWindow(dpy, screen);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11436
#ifndef IRIS
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11437
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11438
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11439
         * on IRIS, this creates a badwindow error - why ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11440
         * children contains a funny window (000034)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11441
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11442
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11443
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11444
         * care for virtual root windows (tvtwm & friends)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11445
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11446
        {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11447
            Atom vRootAtom, kwinAtom;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11448
            int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11449
            Window rootReturn, parentReturn;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11450
            Window* children = (Window *)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11451
            unsigned int numChildren;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11452
            int ignoreVRoot = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11453
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11454
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11455
             * Take care of KDE 2.1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11456
             * they define _SWM_ROOT but this is not the parent of
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11457
             * the application windows.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11458
             * Instead it is used for background painting
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11459
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11460
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11461
            kwinAtom = XInternAtom(dpy, "KWIN_RUNNING", True);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11462
            if (kwinAtom != None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11463
                Atom actual_type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11464
                int actual_format;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11465
                unsigned long nitems, bytesafter;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11466
                unsigned char *retVal = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11467
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11468
                ignoreVRoot = XGetWindowProperty(dpy, rootWin, kwinAtom,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11469
                                       0L, 1L, False, kwinAtom,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11470
                                       &actual_type, &actual_format,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11471
                                       &nitems, &bytesafter, &retVal) == Success
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11472
                              && actual_type != 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11473
                if (retVal)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11474
                    XFree(retVal);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11475
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11476
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11477
            if (!ignoreVRoot) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11478
                vRootAtom = XInternAtom(dpy, "__SWM_VROOT", True);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11479
                if (vRootAtom != None) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11480
                    if (XQueryTree(dpy, rootWin,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11481
                                       &rootReturn, &parentReturn,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11482
                                       &children, &numChildren)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11483
                        for (i=0; i < numChildren; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11484
                            Atom actual_type;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11485
                            int actual_format;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11486
                            unsigned long nitems, bytesafter;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11487
                            Window* newRoot = (Window*) 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11488
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11489
                            if (children[i]) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11490
                                if (XGetWindowProperty(dpy, children[i], vRootAtom,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11491
                                                       0L, 1L, False, XA_WINDOW,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11492
                                                       &actual_type, &actual_format,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11493
                                                       &nitems, &bytesafter,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11494
                                                       (unsigned char**) &newRoot
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11495
                                                      ) == Success && newRoot) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11496
                                    vRootWin = *newRoot;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11497
                                    XFree(newRoot); /* XXX */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11498
                                    break;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11499
                                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11500
                            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11501
                        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11502
                        if (children) XFree(children);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11503
                    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11504
                }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11505
             }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11506
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11507
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11508
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11509
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11510
    if (! vRootWin) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11511
        vRootWin = rootWin;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11512
        if (! vRootWin) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11513
            RETURN ( nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11514
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11515
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11516
    id = __MKEXTERNALADDRESS(rootWin); __INST(rootId) = id; __STORE(self, id);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11517
    id = __MKEXTERNALADDRESS(vRootWin); __INST(virtualRootId) = id; __STORE(self, id);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11518
    RETURN ( id );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11519
%}
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11520
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11521
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11522
      Display rootWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11523
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11524
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11525
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11526
!XWorkstation methodsFor:'window stuff'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11527
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11528
clearRectangleX:x y:y width:width height:height in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11529
    "clear a rectangular area to viewbackground"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11530
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11531
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11532
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11533
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11534
    int w, h;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11535
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11536
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11537
        if (__isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11538
         && __bothSmallInteger(x, y)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11539
         && __bothSmallInteger(width, height)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11540
            w = __intVal(width);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11541
            h = __intVal(height);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11542
            /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11543
             * need this check here: some servers simply dump core with bad args
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11544
             */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11545
            if ((w >= 0) && (h >= 0)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11546
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11547
                XClearArea(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y), w, h, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11548
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11549
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11550
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11551
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11552
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11553
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11554
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11555
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11556
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11557
clearWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11558
    "clear a window to viewbackground"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11559
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11560
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11561
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11562
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11563
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11564
        if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11565
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11566
            XClearWindow(myDpy, __WindowVal(aWindowId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11567
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11568
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11569
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11570
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11571
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11572
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11573
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11574
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11575
configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11576
    "configure stacking operation of aWindowId w.r.t siblingId"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11577
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11578
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11579
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11580
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11581
    XWindowChanges chg;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11582
    int mask = CWSibling | CWStackMode;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11583
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11584
    if (ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11585
        if (__isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11586
         && __isExternalAddress(siblingId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11587
            if (modeSymbol == @symbol(above)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11588
                chg.stack_mode = Above;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11589
            } else if (modeSymbol == @symbol(below)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11590
                chg.stack_mode = Below;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11591
            } else if (modeSymbol == @symbol(topIf)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11592
                chg.stack_mode = TopIf;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11593
            } else if (modeSymbol == @symbol(bottomIf)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11594
                chg.stack_mode = BottomIf;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11595
            } else if (modeSymbol == @symbol(opposite)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11596
                chg.stack_mode = Opposite;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11597
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11598
                mask = CWSibling;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11599
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11600
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11601
            chg.sibling = __WindowVal(siblingId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11602
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11603
            XConfigureWindow(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11604
                                    mask, &chg);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11605
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11606
            RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11607
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11608
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11609
bad: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11610
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11611
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11612
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11613
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11614
getGeometryOf:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11615
    "get a windows geometry.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11616
     NOTICE: X-WindowManagers usually do wrap client topViews into their own
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11617
     decoration views (top label, resize boundaries etc.).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11618
     Thus, the numbers returned here for topViews are the physical (real) dimensions
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11619
     relative to such a wrapper.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11620
     In contrast, the values found in the views instance variables are virtual dimensions
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11621
     (i.e. ST/X makes this decoration view transparent to the program."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11622
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11623
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11624
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11625
    |x y width height depth borderWidth info|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11626
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11627
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11628
    int x_ret, y_ret;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11629
    unsigned int width_ret, height_ret,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11630
                 border_width_ret, depth_ret;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11631
    Window root_ret;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11632
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11633
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11634
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11635
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11636
        XGetGeometry(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11637
                     &root_ret,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11638
                     &x_ret, &y_ret,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11639
                     &width_ret, &height_ret, &border_width_ret,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11640
                     &depth_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11641
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11642
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11643
        x = __MKSMALLINT(x_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11644
        y = __MKSMALLINT(y_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11645
        width = __MKSMALLINT(width_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11646
        height = __MKSMALLINT(height_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11647
        depth = __MKSMALLINT(depth_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11648
        borderWidth = __MKSMALLINT(border_width_ret);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11649
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11650
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11651
    borderWidth isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11652
        self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11653
        ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11654
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11655
    info := Dictionary new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11656
    info at:#origin put:(x @ y).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11657
    info at:#extent put:(width @ height).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11658
    info at:#depth  put:depth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11659
    info at:#borderWidth put:borderWidth.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11660
    ^ info
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11661
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11662
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11663
     Transcript topView device
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11664
        getGeometryOf:(Transcript id)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11665
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11666
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11667
     Transcript topView device
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11668
        getGeometryOf:(Transcript topView id)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11669
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11670
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11671
     Display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11672
        getGeometryOf:(Display viewIdFromUser)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11673
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11674
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11675
     |d|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11676
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11677
     d := Transcript topView device.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11678
     d getGeometryOf:(d parentWindowIdOf:Transcript topView id)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11679
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11680
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11681
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11682
isValidWindowId:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11683
    "return true, if the given window ID is (still) valid.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11684
     Especially useful, if the passed windowID is
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11685
     an alien (external) windows id."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11686
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11687
    |ret|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11688
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11689
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11690
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11691
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11692
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11693
        char *name = NULL;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11694
        Status ok;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11695
        Window root, parent, *children = NULL;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11696
        unsigned int nChildren;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11697
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11698
/*        ENTER_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11699
        ok = XQueryTree(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11700
                        &root, &parent, &children, &nChildren);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11701
        if (children) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11702
            XFree(children);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11703
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11704
/*        LEAVE_XLIB();   */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11705
        if (ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11706
            RETURN (true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11707
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11708
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11709
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11710
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11711
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11712
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11713
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11714
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11715
     |v aWindowId ok|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11716
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11717
     v := StandardSystemView new.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11718
     v label:'hello'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11719
     v openAndWait.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11720
     aWindowId := v id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11721
     ok := Display isValidWindowId:aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11722
     Transcript showCR:'ok is: ' , ok printString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11723
     Delay waitForSeconds:1.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11724
     v destroy.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11725
     ok := Display isValidWindowId:aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11726
     Transcript showCR:'ok is: ' , ok printString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11727
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11728
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11729
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11730
lowerWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11731
    "bring a window to back"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11732
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11733
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11734
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11735
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11736
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11737
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11738
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11739
        XLowerWindow(myDpy, __WindowVal(aWindowId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11740
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11741
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11742
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11743
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11744
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11745
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11746
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11747
mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11748
              width:w height:h minExtent:minExt maxExtent:maxExt
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11749
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11750
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11751
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11752
    "make a window visible - either as icon or as a real view
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11753
     in addition, allow change of extend, position, minExtend and maxExtent.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11754
     Needed for restart, to allow recreating a view as iconified,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11755
     and to collaps/expand windows."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11756
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11757
    |wicon wiconId iconMaskId wiconView wiconViewId wlabel minW minH maxW maxH|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11758
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11759
    aBoolean ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11760
        wicon := aView icon.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11761
        wicon notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11762
            wiconId := wicon id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11763
            wicon mask notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11764
                iconMaskId := wicon mask id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11765
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11766
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11767
        wiconView := aView iconView.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11768
        wiconView notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11769
            wiconViewId := wiconView id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11770
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11771
        wlabel := aView label.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11772
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11773
    minExt notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11774
        minW := minExt x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11775
        minH := minExt y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11776
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11777
    maxExt notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11778
        maxW := maxExt x.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11779
        maxH := maxExt y.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11780
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11781
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11782
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11783
    XWMHints wmhints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11784
    XSizeHints szhints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11785
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11786
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11787
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11788
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11789
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11790
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11791
        win = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11792
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11793
        szhints.flags = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11794
        if (__bothSmallInteger(xPos, yPos)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11795
            szhints.x = __intVal(xPos);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11796
            szhints.y = __intVal(yPos);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11797
            szhints.flags |= USPosition;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11798
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11799
        if (__bothSmallInteger(w, h)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11800
            szhints.width = __intVal(w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11801
            szhints.height = __intVal(h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11802
            szhints.flags |= USSize;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11803
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11804
        if (__bothSmallInteger(minW, minH)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11805
            szhints.flags |= PMinSize;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11806
            szhints.min_width = __intVal(minW);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11807
            szhints.min_height = __intVal(minH);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11808
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11809
        if (__bothSmallInteger(maxW, maxH)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11810
            szhints.flags |= PMaxSize;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11811
            szhints.max_width = __intVal(maxW);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11812
            szhints.max_height = __intVal(maxH);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11813
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11814
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11815
        if (aBoolean == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11816
            char *windowName = "";
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11817
            Pixmap iconBitmap = (Pixmap)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11818
            Pixmap iconMask = (Pixmap)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11819
            Window iconWindow = (Window)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11820
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11821
            if (__isExternalAddress(wiconId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11822
                iconBitmap = __PixmapVal(wiconId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11823
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11824
            if (__isExternalAddress(iconMaskId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11825
                iconMask = __PixmapVal(iconMaskId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11826
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11827
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11828
            if (__isExternalAddress(wiconViewId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11829
                iconWindow = __WindowVal(wiconViewId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11830
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11831
            if (__isStringLike(wlabel))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11832
                windowName = (char *) __stringVal(wlabel);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11833
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11834
            if (iconBitmap || windowName) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11835
                ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11836
                XSetStandardProperties(dpy, win,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11837
                                        windowName, windowName,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11838
                                        iconBitmap,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11839
                                        0, 0, &szhints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11840
                LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11841
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11842
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11843
            wmhints.flags = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11844
            if (iconBitmap) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11845
                wmhints.flags |= IconPixmapHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11846
                wmhints.icon_pixmap = iconBitmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11847
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11848
            if (iconMask) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11849
                wmhints.flags |= IconMaskHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11850
                wmhints.icon_mask = iconMask;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11851
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11852
            if (iconWindow) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11853
                wmhints.flags |= IconWindowHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11854
                wmhints.icon_window = iconWindow;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11855
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11856
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11857
            wmhints.initial_state = IconicState;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11858
            wmhints.flags |= StateHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11859
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11860
            XSetWMHints(dpy, win, &wmhints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11861
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11862
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11863
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11864
        if (szhints.flags) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11865
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11866
            XSetNormalHints(dpy, win, &szhints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11867
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11868
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11869
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11870
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11871
        XMapWindow(dpy, win);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11872
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11873
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11874
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11875
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11876
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11877
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11878
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11879
mapWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11880
    "make a window visible"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11881
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11882
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11883
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11884
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11885
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11886
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11887
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11888
        XMapWindow(myDpy, __WindowVal(aWindowId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11889
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11890
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11891
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11892
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11893
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11894
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11895
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11896
moveResizeWindow:aWindowId x:x y:y width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11897
    "move and resize a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11898
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11899
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11900
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11901
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11902
    int newWidth, newHeight;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11903
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11904
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11905
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11906
     && __bothSmallInteger(w, h)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11907
     && __bothSmallInteger(x, y)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11908
        newWidth = __intVal(w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11909
        newHeight = __intVal(h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11910
        if (newWidth < 1) newWidth = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11911
        if (newHeight < 1) newHeight = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11912
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11913
        XMoveResizeWindow(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11914
                              __intVal(x), __intVal(y),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11915
                              newWidth, newHeight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11916
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11917
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11918
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11919
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11920
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11921
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11922
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11923
moveWindow:aWindowId x:x y:y
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11924
    "move a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11925
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11926
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11927
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11928
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11929
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11930
     && __isExternalAddress(aWindowId) && __bothSmallInteger(x, y)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11931
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11932
        XMoveWindow(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11933
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11934
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11935
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11936
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11937
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11938
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11939
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11940
newGraphicsContextFor:aGraphicsMedium
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11941
    "create a new graphics context.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11942
     The defaults is to use the inherited graphics context.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11943
     Subclasses may redefine this to use their own graphics context"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11944
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11945
"/    ^ aGraphicsMedium.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11946
    |gc|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11947
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11948
    gc := X11GraphicsContext onDevice:self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11949
    gc font:aGraphicsMedium class defaultFont.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11950
    ^ gc.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11951
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11952
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11953
parentWindowIdOf:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11954
    "return a windows parent-window id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11955
     Useful with getGeometryOf:, to compute information about the decoration."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11956
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11957
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11958
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11959
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11960
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11961
        Status ok;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11962
        Window root, parent, *children = NULL;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11963
        unsigned int nChildren;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11964
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11965
/*        ENTER_XLIB(); */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11966
        ok = XQueryTree(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11967
                        &root, &parent, &children, &nChildren);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11968
        if (children) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11969
            XFree(children);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11970
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11971
/*        LEAVE_XLIB();   */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11972
        if (! ok) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11973
            RETURN ( nil );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11974
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11975
        RETURN ( __MKEXTERNALADDRESS(parent) );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11976
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11977
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11978
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11979
    ^ false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11980
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11981
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11982
     |id|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11983
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11984
     id := Transcript device parentWindowIdOf:(Transcript id).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11985
     self assert: ( Transcript container id = id ).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11986
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11987
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11988
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11989
raiseWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11990
    "bring a window to front"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11991
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11992
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11993
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11994
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11995
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11996
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11997
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11998
        XRaiseWindow(myDpy, __WindowVal(aWindowId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 11999
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12000
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12001
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12002
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12003
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12004
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12005
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12006
reparentWindow:windowId to:newParentWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12007
    "change a windows parent (an optional interface)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12008
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12009
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12010
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12011
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12012
     && __isExternalAddress(windowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12013
     && __isExternalAddress(newParentWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12014
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12015
        Window _child, _newParent;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12016
        int i;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12017
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12018
        _child = __WindowVal(windowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12019
        _newParent = __WindowVal(newParentWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12020
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12021
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12022
#if 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12023
        XWithdrawWindow (dpy, _child, DefaultScreen(dpy));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12024
        XSync (dpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12025
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12026
        /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12027
         * Code 'stolen' from xswallow source ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12028
         * ... mhmh - what is this loop for ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12029
         */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12030
        for (i=0; i<5; i++) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12031
            XReparentWindow (dpy, _child, _newParent, 0, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12032
            XSync (dpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12033
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12034
#if 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12035
        XMapWindow (dpy, _child);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12036
        XSync (dpy, 0);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12037
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12038
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12039
        RETURN ( true );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12040
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12041
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12042
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12043
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12044
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12045
resizeWindow:aWindowId width:w height:h
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12046
    "resize a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12047
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12048
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12049
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12050
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12051
    int newWidth, newHeight;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12052
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12053
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12054
     && __isExternalAddress(aWindowId) && __bothSmallInteger(w, h)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12055
        newWidth = __intVal(w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12056
        newHeight = __intVal(h);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12057
        if (newWidth < 1) newWidth = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12058
        if (newHeight < 1) newHeight = 1;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12059
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12060
        XResizeWindow(myDpy, __WindowVal(aWindowId), newWidth, newHeight);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12061
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12062
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12063
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12064
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12065
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12066
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12067
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12068
setBackingStore:how in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12069
    "turn on/off backing-store for a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12070
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12071
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12072
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12073
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12074
    XSetWindowAttributes wa;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12075
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12076
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12077
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12078
        if (__INST(ignoreBackingStore) != true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12079
            if (how == @symbol(always)) wa.backing_store = Always;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12080
            else if (how == @symbol(whenMapped)) wa.backing_store = WhenMapped;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12081
            else if (how == true) wa.backing_store = Always;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12082
            else wa.backing_store = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12083
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12084
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12085
            XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBackingStore, &wa);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12086
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12087
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12088
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12089
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12090
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12091
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12092
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12093
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12094
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12095
setBitGravity:how in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12096
    "set bit gravity for a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12097
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12098
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12099
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12100
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12101
    XSetWindowAttributes wa;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12102
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12103
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12104
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12105
        if (how == @symbol(NorthWest)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12106
            wa.bit_gravity = NorthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12107
        } else if (how == @symbol(NorthEast)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12108
            wa.bit_gravity = NorthEastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12109
        } else if (how == @symbol(SouthWest)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12110
            wa.bit_gravity = SouthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12111
        } else if (how == @symbol(SouthEast)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12112
            wa.bit_gravity = SouthEastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12113
        } else if (how == @symbol(Center)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12114
            wa.bit_gravity = CenterGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12115
        } else if (how == @symbol(North)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12116
            wa.bit_gravity = NorthGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12117
        } else if (how == @symbol(South)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12118
            wa.bit_gravity = SouthGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12119
        } else if (how == @symbol(West)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12120
            wa.bit_gravity = WestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12121
        } else if (how == @symbol(East)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12122
            wa.bit_gravity = EastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12123
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12124
            wa.bit_gravity = NorthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12125
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12126
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12127
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12128
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12129
        XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBitGravity, &wa);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12130
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12131
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12132
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12133
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12134
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12135
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12136
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12137
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12138
setCursor:aCursorId in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12139
    "define a windows cursor"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12140
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12141
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12142
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12143
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12144
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12145
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12146
     && __isExternalAddress(aCursorId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12147
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12148
        Window w = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12149
        Cursor c = __CursorVal(aCursorId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12150
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12151
        if (w && c) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12152
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12153
            XDefineCursor(dpy, w, c);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12154
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12155
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12156
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12157
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12158
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12159
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12160
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12161
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12162
setForegroundWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12163
    "bring a window to front.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12164
     Send a specific message to the WindowManager"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12165
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12166
    |activeWindowAtom|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12167
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12168
"/    self raiseWindow:aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12169
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12170
    activeWindowAtom := self atomIDOf:#'_NET_ACTIVE_WINDOW' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12171
    activeWindowAtom notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12172
        self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12173
            sendClientEvent:activeWindowAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12174
            format:32
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12175
            to:(self rootWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12176
            propagate:false
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12177
            eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12178
            window:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12179
            data1:2                 "activate request from pager. This is a trick: kwm ignores requests from applications (1)"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12180
            data2:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12181
            data3:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12182
            data4:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12183
            data5:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12184
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12185
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12186
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12187
      Transcript topView setForegroundWindow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12188
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12189
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12190
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12191
setIconName:aString in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12192
    "define a windows iconname"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12193
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12194
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12195
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12196
    |utf8StringAtom utf8String simpleString|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12197
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12198
    utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12199
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12200
    utf8String := aString utf8Encoded.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12201
    aString isWideString ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12202
        "/ X does not like 2-byte labels ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12203
        simpleString := aString asSingleByteStringReplaceInvalidWith:$?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12204
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12205
        simpleString := aString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12206
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12207
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12208
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12209
    XTextProperty titleProperty;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12210
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12211
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12212
     && __isStringLike(utf8String)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12213
     && __isStringLike(simpleString)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12214
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12215
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12216
        titleProperty.value =  __stringVal(utf8String);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12217
        titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12218
        titleProperty.format = 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12219
        titleProperty.nitems = __stringSize(utf8String);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12220
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12221
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12222
        XSetIconName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12223
        /* alternative settings for UTF8-Strings */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12224
        XSetWMIconName(myDpy, __WindowVal(aWindowId), &titleProperty);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12225
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12226
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12227
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12228
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12229
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12230
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12231
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12232
setSaveUnder:yesOrNo in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12233
    "turn on/off save-under for a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12234
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12235
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12236
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12237
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12238
    XSetWindowAttributes wa;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12239
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12240
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12241
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12242
        if (__INST(hasSaveUnder) == true) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12243
            wa.save_under = (yesOrNo == true) ? 1 : 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12244
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12245
            XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWSaveUnder, &wa);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12246
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12247
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12248
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12249
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12250
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12251
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12252
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12253
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12254
setTransient:aWindowId for:aMainWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12255
    "set aWindowId to be a transient of aMainWindow"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12256
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12257
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12258
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12259
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12260
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12261
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12262
        Window w;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12263
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12264
        if ((aMainWindowId == nil) || (aMainWindowId == __MKSMALLINT(0))) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12265
            w = (Window) 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12266
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12267
            if (__isExternalAddress(aMainWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12268
                w = __WindowVal(aMainWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12269
            } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12270
                goto getOutOfHere;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12271
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12272
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12273
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12274
        XSetTransientForHint(myDpy, __WindowVal(aWindowId), w);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12275
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12276
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12277
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12278
 getOutOfHere: ;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12279
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12280
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12281
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12282
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12283
setWindowBackground:aColorIndex in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12284
    "set the windows background color. This is the color with which
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12285
     the view is filled whenever exposed. Do not confuse this with
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12286
     the background drawing color, which is used with opaque drawing."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12287
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12288
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12289
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12290
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12291
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12292
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12293
     && __isSmallInteger(aColorIndex)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12294
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12295
        XSetWindowBackground(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12296
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12297
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12298
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12299
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12300
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12301
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12302
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12303
setWindowBackgroundPixmap:aPixmapId in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12304
    "set the windows background pattern to be a form.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12305
     This is the pattern with which the view is filled whenever exposed.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12306
     Do not confuse this with the background drawing color, which is used
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12307
     with opaque drawing."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12308
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12309
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12310
%{  /* STACK: 64000 */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12311
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12312
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12313
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12314
     && __isExternalAddress(aPixmapId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12315
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12316
        XSetWindowBackgroundPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12317
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12318
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12319
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12320
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12321
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12322
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12323
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12324
setWindowBorderColor:aColorIndex in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12325
    "set the windows border color"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12326
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12327
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12328
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12329
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12330
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12331
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12332
     && __isSmallInteger(aColorIndex)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12333
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12334
        XSetWindowBorder(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12335
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12336
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12337
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12338
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12339
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12340
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12341
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12342
setWindowBorderPixmap:aPixmapId in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12343
    "set the windows border pattern"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12344
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12345
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12346
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12347
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12348
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12349
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12350
     && __isExternalAddress(aPixmapId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12351
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12352
        XSetWindowBorderPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12353
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12354
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12355
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12356
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12357
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12358
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12359
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12360
setWindowBorderShape:aPixmapId in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12361
    "set the windows border shape"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12362
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12363
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12364
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12365
    hasShapeExtension ifFalse:[^ self].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12366
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12367
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12368
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12369
#ifdef SHAPE
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12370
    Pixmap shapeBitmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12371
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12372
    if (__isExternalAddress(aPixmapId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12373
        shapeBitmap = __PixmapVal(aPixmapId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12374
    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12375
        shapeBitmap = (Pixmap)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12376
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12377
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12378
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12379
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12380
        XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeBounding,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12381
                          0, 0, shapeBitmap, ShapeSet);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12382
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12383
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12384
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12385
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12386
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12387
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12388
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12389
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12390
setWindowBorderWidth:aNumber in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12391
    "set the windows border width"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12392
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12393
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12394
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12395
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12396
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12397
     && __isExternalAddress(aWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12398
     && __isSmallInteger(aNumber)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12399
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12400
        XSetWindowBorderWidth(myDpy, __WindowVal(aWindowId), __intVal(aNumber));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12401
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12402
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12403
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12404
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12405
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12406
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12407
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12408
setWindowClass:wClass name:wName in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12409
    "define class and name of a window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12410
     This may be used by the window manager to
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12411
     select client specific resources."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12412
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12413
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12414
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12415
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12416
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12417
        XClassHint classhint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12418
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12419
        classhint.res_class = classhint.res_name = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12420
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12421
        if (__isStringLike(wClass)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12422
            classhint.res_class = (char *) __stringVal(wClass);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12423
        } else if (wClass != nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12424
            goto error;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12425
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12426
        if (__isStringLike(wName)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12427
            classhint.res_name = (char *) __stringVal(wName);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12428
        } else if (wName != nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12429
            goto error;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12430
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12431
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12432
        XSetClassHint(myDpy, __WindowVal(aWindowId), &classhint);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12433
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12434
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12435
error:;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12436
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12437
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12438
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12439
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12440
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12441
setWindowGravity:how in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12442
    "set window gravity for a window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12443
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12444
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12445
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12446
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12447
    XSetWindowAttributes wa;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12448
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12449
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12450
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12451
        if (how == @symbol(NorthWest)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12452
            wa.win_gravity = NorthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12453
        } else if (how == @symbol(NorthEast)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12454
            wa.win_gravity = NorthEastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12455
        } else if (how == @symbol(SouthWest)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12456
            wa.win_gravity = SouthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12457
        } else if (how == @symbol(SouthEast)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12458
            wa.win_gravity = SouthEastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12459
        } else if (how == @symbol(Center)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12460
            wa.win_gravity = CenterGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12461
        } else if (how == @symbol(North)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12462
            wa.win_gravity = NorthGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12463
        } else if (how == @symbol(South)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12464
            wa.win_gravity = SouthGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12465
        } else if (how == @symbol(West)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12466
            wa.win_gravity = WestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12467
        } else if (how == @symbol(East)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12468
            wa.win_gravity = EastGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12469
        } else {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12470
            wa.win_gravity = NorthWestGravity;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12471
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12473
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12474
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12475
        XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWWinGravity, &wa);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12476
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12477
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12478
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12479
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12480
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12481
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12482
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12483
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12484
setWindowIcon:aForm in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12485
    "define a bitmap to be used as icon"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12486
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12487
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12488
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12489
    |iconId|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12490
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12491
    aForm notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12492
        iconId := aForm id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12493
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12494
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12495
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12496
     && __isExternalAddress(iconId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12497
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12498
        XWMHints hints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12499
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12500
        hints.icon_pixmap = __PixmapVal(iconId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12501
        hints.flags = IconPixmapHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12502
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12503
        XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12504
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12505
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12506
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12507
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12508
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12509
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12510
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12511
setWindowIcon:aForm mask:aMaskForm in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12512
    "define a windows icon and (optional) iconMask."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12513
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12514
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12515
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12516
    |iconId maskId|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12517
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12518
    aForm notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12519
        iconId := aForm id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12520
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12521
    aMaskForm notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12522
        maskId := aMaskForm id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12523
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12524
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12525
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12526
     && __isExternalAddress(iconId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12527
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12528
        XWMHints hints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12529
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12530
        hints.icon_pixmap = __PixmapVal(iconId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12531
        hints.flags = IconPixmapHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12532
        if ((maskId != nil)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12533
         && __isExternalAddress(maskId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12534
            hints.icon_mask = __PixmapVal(maskId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12535
            hints.flags |= IconMaskHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12536
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12537
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12538
        XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12539
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12540
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12541
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12542
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12543
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12544
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12545
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12546
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12547
setWindowIconWindow:aView in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12548
    "define a window to be used as icon"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12549
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12550
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12551
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12552
    |iconWindowId|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12553
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12554
    aView notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12555
        iconWindowId := aView id
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12556
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12557
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12558
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12559
     && __isExternalAddress(iconWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12560
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12561
        XWMHints wmhints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12562
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12563
        wmhints.icon_window = __WindowVal(iconWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12564
        wmhints.flags = IconWindowHint;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12565
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12566
        XSetWMHints(myDpy, __WindowVal(aWindowId), &wmhints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12567
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12568
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12569
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12570
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12571
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12572
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12573
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12574
setWindowMinExtentX:minW y:minH maxExtentX:maxW y:maxH in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12575
    "set a windows minimum & max extents.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12576
     nil arguments are ignored."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12577
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12578
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12579
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12580
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12581
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12582
        Display *dpy = myDpy;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12583
        XSizeHints szhints;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12584
        Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12585
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12586
        win = __WindowVal(aWindowId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12587
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12588
        szhints.flags = 0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12589
        if (__bothSmallInteger(minW, minH)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12590
            szhints.flags |= PMinSize;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12591
            szhints.min_width = __intVal(minW);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12592
            szhints.min_height = __intVal(minH);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12593
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12594
        if (__bothSmallInteger(maxW, maxH)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12595
            szhints.flags |= PMaxSize;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12596
            szhints.max_width = __intVal(maxW);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12597
            szhints.max_height = __intVal(maxH);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12598
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12599
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12600
        if (szhints.flags) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12601
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12602
            XSetNormalHints(dpy, win, &szhints);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12603
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12604
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12605
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12606
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12607
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12608
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12609
setWindowName:aString in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12610
    "define a windows name"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12611
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12612
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12613
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12614
    |utf8StringAtom utf8String simpleString|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12615
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12616
    utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12617
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12618
    utf8String := aString utf8Encoded.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12619
    aString isWideString ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12620
        "/ X does not like 2-byte labels ...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12621
        simpleString := aString asSingleByteStringReplaceInvalidWith:$?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12622
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12623
        simpleString := aString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12624
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12625
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12626
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12627
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12628
    XTextProperty titleProperty;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12629
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12630
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12631
     && __isStringLike(utf8String)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12632
     && __isStringLike(simpleString)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12633
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12634
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12635
        titleProperty.value =  __stringVal(utf8String);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12636
        titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12637
        titleProperty.format = 8;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12638
        titleProperty.nitems = __stringSize(utf8String);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12639
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12640
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12641
        XStoreName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12642
        /* alternative settings for UTF8-Strings */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12643
        XSetWMName(myDpy, __WindowVal(aWindowId), &titleProperty);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12644
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12645
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12646
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12647
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12648
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12649
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12650
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12651
setWindowPid:anIntegerOrNil in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12652
    "Sets the _NET_WM_PID property for the window.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12653
     This may be used by the window manager to group windows.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12654
     If anIntegerOrNil is nil, then PID of currently running
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12655
     Smalltalk is used"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12656
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12657
    | propertyID typeId pid |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12658
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12659
    propertyID := self atomIDOf: '_NET_WM_PID' create: false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12660
    propertyID isNil ifTrue:[ ^ self ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12661
    pid := anIntegerOrNil isNil ifTrue:[OperatingSystem getProcessId] ifFalse:[anIntegerOrNil].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12662
    typeId := self atomIDOf:#'CARDINAL' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12663
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12664
    self setProperty:propertyID type:typeId value:pid for:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12665
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12666
    "Created: / 04-01-2013 / 16:03:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12667
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12668
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12669
setWindowShape:aPixmapId in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12670
    "set the windows shape.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12671
     Returns false, if the display does not support the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12672
     X shape extension."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12673
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12674
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12675
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12676
    hasShapeExtension ifFalse:[^ self].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12677
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12678
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12679
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12680
#ifdef SHAPE
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12681
    Pixmap shapeBitmap;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12682
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12683
    if (__isExternalAddress(aPixmapId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12684
        shapeBitmap = __PixmapVal(aPixmapId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12685
    else
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12686
        shapeBitmap = (Pixmap)0;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12687
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12688
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12689
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12690
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12691
        XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeClip,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12692
                          0, 0,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12693
                          shapeBitmap, ShapeSet);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12694
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12695
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12696
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12697
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12698
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12699
    self primitiveFailedOrClosedConnection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12700
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12701
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12702
setWindowState:aSymbol in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12703
    "tell the window type to the window manager.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12704
     Send a specific message to the WindowManager"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12705
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12706
    |netWmWindowStateAtom stateAtom|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12707
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12708
    netWmWindowStateAtom := self atomIDOf:#'_NET_WM_WINDOW_STATE' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12709
    stateAtom := self atomIDOf:aSymbol create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12710
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12711
    (netWmWindowStateAtom notNil and:[stateAtom notNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12712
        self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12713
            sendClientEvent:netWmWindowStateAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12714
            format:32
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12715
            to:(self rootWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12716
            propagate:true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12717
            eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12718
            window:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12719
            data1:(self atomIDOf:#'_NET_WM_STATE_ADD' create:false)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12720
            data2:stateAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12721
            data3:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12722
            data4:1
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12723
            data5:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12724
    ] ifFalse:[self halt.].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12725
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12726
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12727
      |v|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12728
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12729
      v := TopView new create.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12730
      Display setWindowState:#'_NET_WM_WINDOW_STATE_STICKY' in:v id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12731
      v open.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12732
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12733
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12734
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12735
setWindowType:aSymbol in:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12736
    "Tell the window type to the window manager.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12737
     See Extended Window Manager Hints 1.3,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12738
     chapter 'Application Window Properties'
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12739
     http://standards.freedesktop.org/wm-spec/1.3/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12740
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12741
    JV@2012-05-15: There was some code prior 2012-05-15,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12742
    but that code does not work anymore and I wonder if it
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12743
    ever worked correctly. I changed it to be
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12744
    EWMH compatible, as this improve UX on modern Linxu
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12745
    machines.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12746
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12747
    It also helps to fix super-annoying problem with window autoraiser
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12748
    on X11 in a proper way - window manager should manage top-level
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12749
    window stacking, that's why it is called a 'window manager' :-)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12750
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12751
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12752
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12753
    | nameAtom typeAtom valueAtom |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12754
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12755
    self assert:(#(_NET_WM_WINDOW_TYPE_DESKTOP
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12756
                  _NET_WM_WINDOW_TYPE_DOCK
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12757
                  _NET_WM_WINDOW_TYPE_TOOLBAR
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12758
                  _NET_WM_WINDOW_TYPE_MENU
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12759
                  _NET_WM_WINDOW_TYPE_UTILITY
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12760
                  _NET_WM_WINDOW_TYPE_SPLASH
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12761
                  _NET_WM_WINDOW_TYPE_DIALOG
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12762
                  _NET_WM_WINDOW_TYPE_NORMAL) includes: aSymbol).
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12763
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12764
    nameAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12765
    nameAtom isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12766
        "/Hmm, no such property, not running under EWMH compliant WM?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12767
        self breakPoint: #jv.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12768
        ^self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12769
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12770
    "/ Hmm, hmm, no access to XA_ATOM, XA_INTEGER and so on...
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12771
    typeAtom := self atomIDOf:#'ATOM' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12772
    typeAtom isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12773
        self error:'Oops, no ATOM atom'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12774
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12775
    valueAtom := self atomIDOf: aSymbol create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12776
    valueAtom isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12777
        "/Hmm, no such property, not running under EWMH compliant WM?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12778
        self breakPoint: #jv.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12779
        ^self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12780
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12781
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12782
    self setProperty: nameAtom type: typeAtom value: valueAtom for: aWindowId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12783
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12784
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12785
"/   Original code that does not work (if ever worked)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12786
"/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12787
"/    |netWmWindowTypeAtom typeAtom|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12788
"/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12789
"/    netWmWindowTypeAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12790
"/    typeAtom := self atomIDOf:aSymbol create:false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12791
"/
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12792
"/    (netWmWindowTypeAtom notNil and:[typeAtom notNil]) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12793
"/        self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12794
"/            sendClientEvent:netWmWindowTypeAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12795
"/            format:32
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12796
"/            to:(self rootWindowId)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12797
"/            propagate:true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12798
"/            eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12799
"/            window:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12800
"/            data1:typeAtom
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12801
"/            data2:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12802
"/            data3:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12803
"/            data4:nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12804
"/            data5:nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12805
"/    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12806
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12807
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12808
      |v|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12809
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12810
      v := TopView new create.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12811
      Display setWindowType:#'_NET_WM_WINDOW_TYPE_DOCK' in:v id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12812
      v open.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12813
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12814
      |v|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12815
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12816
      v := TopView new create.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12817
      Display setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY' in:v id.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12818
      v open.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12819
    "
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12820
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12821
    "Modified (comment): / 15-05-2012 / 10:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12822
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12823
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12824
unmapWindow:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12825
    "make a window invisible"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12826
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12827
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12828
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12829
    /*
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12830
     * ignore closed connection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12831
     */
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12832
    if (! ISCONNECTED) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12833
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12834
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12835
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12836
    if (__isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12837
        ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12838
        XUnmapWindow(myDpy, __WindowVal(aWindowId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12839
        LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12840
        RETURN ( self );
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12841
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12842
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12843
    self primitiveFailed
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12844
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12845
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12846
windowIsIconified:aWindowId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12847
    "return true, if some window is iconified.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12848
     The passed windowID may be an alien windows id."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12849
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12850
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12851
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12852
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12853
    if (ISCONNECTED
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12854
     && __isExternalAddress(aWindowId)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12855
        Atom JunkAtom;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12856
        int JunkInt;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12857
        unsigned long WinState,JunkLong;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12858
        unsigned char *Property;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12859
        Atom WM_STATE_Atom;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12860
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12861
        if (__INST(wmStateAtom) != nil) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12862
            WM_STATE_Atom = __AtomVal(__INST(wmStateAtom));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12863
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12864
            ENTER_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12865
            XGetWindowProperty(myDpy, __WindowVal(aWindowId),
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12866
                               WM_STATE_Atom,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12867
                               0L, 2L, False, AnyPropertyType,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12868
                               &JunkAtom,&JunkInt,&WinState,&JunkLong,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12869
                               &Property);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12870
            LEAVE_XLIB();
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12871
            WinState=(unsigned long)(*((long*)Property));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12872
            if (WinState==3) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12873
                RETURN (true);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12874
            }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12875
        }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12876
        RETURN (false);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12877
    }
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12878
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12879
    self primitiveFailedOrClosedConnection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12880
    ^ false "/ or true or what ?
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12881
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12882
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12883
!XWorkstation::SelectionFetcher class methodsFor:'documentation'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12884
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12885
documentation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12886
"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12887
    This class is responsible for fetching the clipboard.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12888
    The X11 clipboard is implemented via asynchonous messages.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12889
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12890
    For each fetch operation an instance of this class is created.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12891
    The asynchronous messages are queued and executed in the
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12892
    process that requests the clipboard.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12893
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12894
    [author:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12895
        Stefan Vogel (stefan@zwerg)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12896
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12897
    [instance variables:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12898
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12899
    [class variables:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12900
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12901
    [see also:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12902
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12903
"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12904
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12905
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12906
!XWorkstation::SelectionFetcher class methodsFor:'selections'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12907
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12908
requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12909
    ^ self new requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12910
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12911
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12912
!XWorkstation::SelectionFetcher methodsFor:'accessing'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12913
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12914
drawableID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12915
    ^ drawableID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12916
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12917
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12918
getSelection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12919
    "convert the data in buffer to a selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12920
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12921
    |selection|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12922
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12923
    buffer isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12924
        ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12925
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12926
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12927
    targetID == (display atomIDOf:#STRING) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12928
        display clipboardEncoding notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12929
            selection := buffer decodeFrom:display clipboardEncoding
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12930
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12931
        selection := buffer.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12932
    ] ifFalse:[targetID == (display atomIDOf:#'UTF8_STRING') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12933
"/ Transcript show:'UTF8: '; showCR:buffer storeString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12934
        selection := CharacterArray fromUTF8Bytes:buffer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12935
    ] ifFalse:[targetID == (display atomIDOf:#TEXT) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12936
"/ Transcript show:'TEXT: '; showCR:buffer storeString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12937
        selection := buffer asString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12938
    ] ifFalse:[targetID == (display atomIDOf:#'COMPOUND_TEXT') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12939
"/ Transcript show:'COMPOUND_TEXT: '; showCR:buffer storeString.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12940
        selection := buffer asString
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12941
    ]]]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12942
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12943
    selection notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12944
        (selection endsWith:Character cr) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12945
            selection := selection asStringCollection copyWith:''
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12946
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12947
        ^ selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12948
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12949
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12950
    targetID == (display atomIDOf:#'TARGETS') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12951
        ^ buffer
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12952
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12953
    targetID == (display atomIDOf:#'ST_OBJECT') ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12954
        "require libboss to be loaded"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12955
        (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12956
            'SelectionFetch: cannot decode object (libboss library missing)' errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12957
            ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12958
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12959
        ^ (Object
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12960
            readBinaryFrom:(ReadStream on:buffer)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12961
            onError:[:ex |
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12962
                ('SelectionFetch: error while decoding binary object: ',ex description) errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12963
                nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12964
            ])
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12965
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12966
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12967
    'XWorkstation: unimplemented property targetID: ' infoPrint. (display atomName:targetID) infoPrint.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12968
    ' buffer:' infoPrint. buffer infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12969
    ^ nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12970
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12971
    "Modified: / 23-08-2006 / 15:56:04 / cg"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12972
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12973
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12974
!XWorkstation::SelectionFetcher methodsFor:'event handling'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12975
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12976
message:aMessage
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12977
    "got an asynchronous event from the display.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12978
     Save and wake up waiters"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12979
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12980
    aMessage selector == #propertyChange:property:state:time: ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12981
        (aMessage arguments at:2) ~~ propertyID ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12982
            "I am only interested in changes of the property used to
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12983
             store the selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12984
            ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12985
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12986
        message notNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12987
            "this should not happen - bad selection holder?"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12988
            'XWorkstation(error): message overflow: ' errorPrint. display errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12989
            ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12990
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12991
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12992
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12993
    "we get a propertyChange before the selectionNotify.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12994
     Since the propertyChange will be ignored anyway (because we are not in incremental mod,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12995
     a selectionNotify message may overwrite a propertyChange message"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12996
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12997
    message := aMessage.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12998
    sema signal.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 12999
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13000
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13001
propertyChange:aView property:aPropertyId state:stateSymbol time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13002
    "this is a forwarded propretyChange event from XWorkstation"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13003
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13004
    |property propertyValue|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13005
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13006
    incremental ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13007
        "ignore property changes until we are in incremental mode"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13008
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13009
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13010
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13011
    property := display getProperty:propertyID from:drawableID delete:true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13012
    propertyValue := property value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13013
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13014
    propertyValue size == 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13015
        "property with size 0 signals end of transfer"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13016
        done := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13017
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13018
        buffer isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13019
            targetID := property key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13020
            buffer := propertyValue.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13021
        ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13022
            targetID ~= property key ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13023
                'XWorkstation(warning): targetID change in incremental select: ' errorPrint. display errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13024
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13025
            buffer := buffer, propertyValue.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13026
        ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13027
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13028
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13029
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13030
selectionClear:aView selection:selectionId time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13031
    "sent when another X-client has created a selection.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13032
     This is a very X-specific mechanism."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13033
!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13034
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13035
selectionNotify:aView selection:aSelectionID target:aTargetID property:aPropertyID requestor:requestorID time:time
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13036
    "this is a forwarded selectionNotify event from XWorkstation"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13037
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13038
    |property propertyKey atomName|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13039
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13040
    aSelectionID ~~ selectionID ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13041
        "ignore notification that is not for our selection"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13042
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13043
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13044
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13045
    aPropertyID == 0 ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13046
        "the selection owner could not convert the selection to our target type"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13047
        done := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13048
        ^ self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13049
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13050
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13051
    property := display getProperty:aPropertyID from:drawableID delete:true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13052
    property isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13053
        "the property does not exist in the specified window"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13054
        done := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13055
        ^ self
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13056
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13057
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13058
    propertyKey := property key.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13059
    propertyKey == aTargetID ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13060
        "good, the property is consistent with our request.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13061
         The whole selection is in the property"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13062
        buffer := property value.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13063
        done := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13064
    ] ifFalse:[propertyKey == (display atomIDOf:#INCR) ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13065
        "this is an incremental transfer. Wait for property change"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13066
        incremental := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13067
    ] ifFalse:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13068
        atomName := (display atomName:propertyKey) ? propertyKey.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13069
        'XWorkstation(error): unexpected targetID (' errorPrint.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13070
        atomName errorPrint.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13071
        ') in selectionNotify: ' errorPrint.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13072
        display errorPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13073
        done := true.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13074
    ]].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13075
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13076
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13077
!XWorkstation::SelectionFetcher methodsFor:'selection actions'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13078
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13079
requestSelection:aSelectionId type:aTargetId onDevice:aDisplay for:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13080
    "request the selection of type targetId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13081
     Wait for next asynchronous message and process it,
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13082
     until done"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13083
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13084
    display := aDisplay.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13085
    drawableID := aDrawableId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13086
    selectionID := aSelectionId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13087
    propertyID := display atomIDOf:#'VT_SELECTION'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13088
    targetID := aTargetId.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13089
    sema := Semaphore new name:'X11SelectionFetcher'.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13090
    done := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13091
    incremental := false.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13092
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13093
    [
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13094
        |timeout|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13095
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13096
        display registerSelectionFetcher:self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13097
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13098
        display
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13099
            requestSelection:aSelectionId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13100
            type:aTargetId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13101
            for:drawableID
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13102
            intoProperty:propertyID.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13103
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13104
        timeout := display xlibTimeout.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13105
        [
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13106
            |currentMessage|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13107
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13108
            (sema waitWithTimeout:timeout) isNil ifTrue:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13109
                "the selection owner didn't respond within reasonable time"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13110
                'XWorkstation(error): selection owner does not respond:' infoPrint. display infoPrintCR.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13111
                ^ nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13112
            ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13113
            currentMessage := message.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13114
            message := nil.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13115
            currentMessage notNil ifTrue:[currentMessage sendTo:self].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13116
        ] doUntil:[done].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13117
    ] ensure:[
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13118
        display unregisterSelectionFetcher:self.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13119
    ].
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13120
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13121
    ^ self getSelection
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13122
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13123
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13124
!XWorkstation::SelectionFetcher methodsFor:'testing'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13125
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13126
matchesDrawableId:aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13127
    "return true, if this SelectionFetcher fetches for aDrawableId"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13128
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13129
    ^ drawableID = aDrawableId
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13130
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13131
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13132
!XWorkstation::WindowGroupWindow class methodsFor:'documentation'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13133
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13134
documentation
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13135
"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13136
    A special window to serve as window group id. This window
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13137
    is newer mapped. This window is used
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13138
    in XWMHints & _NET_WM_LEADER properties to define
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13139
    application window group
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13140
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13141
    [author:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13142
        Jan Vrany <jan.vrany@fit.cvut.cz>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13143
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13144
    [instance variables:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13145
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13146
    [class variables:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13147
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13148
    [see also:]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13149
        Inter-Client Communication Conventions Manual [http://tronche.com/gui/x/icccm/]
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13150
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13151
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13152
"
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13153
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13154
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13155
!XWorkstation::WindowGroupWindow methodsFor:'testing'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13156
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13157
isICCCWindowGroupWindow
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13158
    ^ true
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13159
! !
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13160
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13161
!XWorkstation::X11GraphicsContext methodsFor:'displaying'!
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13162
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13163
displayString:aString x:x y:y opaque:opaque
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13164
    "draw a string - if opaque is false, draw foreground only; otherwise, draw both
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13165
     foreground and background characters.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13166
     If the coordinates are not integers, an error is triggered."
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13167
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13168
    <context: #return>
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13169
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13170
    |displayId|
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13171
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13172
    device flushIfAppropriate.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13173
    displayId := device displayIdOrErrorIfBroken.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13174
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13175
%{
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13176
#if 0
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13177
    GC gc;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13178
    Window win;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13179
    char *cp;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13180
    int n;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13181
    OBJ cls;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13182
#   define NLOCALBUFFER 200
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13183
    XChar2b xlatebuffer[NLOCALBUFFER];
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13184
    int nInstBytes;
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13185
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13186
    if (displayId != nil
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13187
     && __isExternalAddress(__INST(gcId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13188
     && __isExternalAddress(__INST(drawableId))
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13189
     && __isNonNilObject(aString)
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13190
     && __bothSmallInteger(x, y)) {
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13191
	int lMax = __intVal(@global(XWorkstation:MaxStringLength));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13192
	Display *dpy = __DisplayVal(displayId);
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13193
	gc = __GCVal(__INST(gcId));
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13194
	win = __WindowVal(__INST(drawableId));
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13195
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13196
	cp = (char *) __stringVal(aString);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13197
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13198
	if (__isStringLike(aString)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13199
	    n = __stringSize(aString);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13200
	    if (n > lMax) n = lMax;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13201
	    ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13202
	    if (opaque == true)
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13203
		XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13204
	    else
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13205
		XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13206
	    LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13207
	    RETURN ( self );
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13208
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13209
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13210
	cls = __qClass(aString);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13211
	nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13212
	cp += nInstBytes;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13213
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13214
	if (__isBytes(aString)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13215
	    n = __byteArraySize(aString) - nInstBytes - 1;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13216
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13217
	    if (n > lMax) n = lMax;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13218
	    ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13219
	    if (opaque == true)
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13220
		XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13221
	    else
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13222
		XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13223
	    LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13224
	    RETURN ( self );
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13225
	}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13226
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13227
	/* TWOBYTESTRINGS */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13228
	if (__isWords(aString)) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13229
	    union {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13230
		char b[2];
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13231
		unsigned short s;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13232
	    } u;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13233
	    int i;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13234
	    XChar2b *cp2;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13235
	    int mustFree = 0;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13236
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13237
	    n = (__byteArraySize(aString) - nInstBytes) / 2;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13238
	    if (n > lMax) n = lMax;
3990
5d9342503bf6 font stuff
Claus Gittinger <cg@exept.de>
parents: 3988
diff changeset
 13239
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
 13240
#if defined(MSBFIRST) || defined(__MSBFIRST)
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13241
	    /*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13242
	     * chars already in correct order
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13243
	     */
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
 13244
#else
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
 13245
# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13246
	    /*
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13247
	     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13248
	     * X expects them MSB first
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13249
	     * convert as required
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13250
	     */
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13251
	    u.s = 0x1234;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13252
	    if (u.b[0] != 0x12)
4029
959f7a19bc1a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
 13253
# endif
6231
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13254
	    {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13255
		if (n <= NLOCALBUFFER) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13256
		    cp2 = xlatebuffer;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13257
		} else {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13258
		    cp2 = (XChar2b *)(malloc(n * 2));
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13259
		    mustFree = 1;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13260
		}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13261
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13262
		for (i=0; i<n; i++) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13263
		    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13264
		    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13265
		}
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13266
		cp = (char *) cp2;
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13267
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13268
#endif
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13269
	    ENTER_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13270
	    if (opaque == true)
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13271
		XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13272
	    else
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13273
		XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13274
	    LEAVE_XLIB();
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13275
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13276
	    if (mustFree) {
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13277
		free(cp2);
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13278
	    }
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13279
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13280
	    RETURN ( self );
62b008701d53 temporary hack fix: ignore XRender errors due to invalid use of Picture/GC
Claus Gittinger <cg@exept.de>
parents: 6224
diff changeset
 13281
	}
486
0c35ed67797d oops - 16bit drawing was corrupted / fixed widthOf-16bit for byteSwapped displays
Claus Gittinger <cg@exept.de>
parents: 481
diff changeset
 13282
    }
461
4a4b1384ab76 X wants 16bit strings in MSBfirst
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
 13283
#undef NLOCALBUFFER
6472
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13284
#endif
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13285
%}.
5b21ff383a12 Delegated gc stuff
Stefan Vogel <sv@exept.de>
parents: 6231
diff changeset
 13286
    ^ super displayString:aString x:x y:y opaque:opaque
5984
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
 13287
! !
7380209f1108 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5983
diff changeset
 13288
1171
a40ea3d796fd newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
 13289
!XWorkstation class methodsFor:'documentation'!
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
 13290
5938
f5d6189257d4 comment/format in: #supportedTargetAtoms
Stefan Vogel <sv@exept.de>
parents: 5936
diff changeset
 13291
version
6573
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
 13292
    ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.2 2014-09-25 21:16:16 stefan Exp $'
5938
f5d6189257d4 comment/format in: #supportedTargetAtoms
Stefan Vogel <sv@exept.de>
parents: 5936
diff changeset
 13293
!
f5d6189257d4 comment/format in: #supportedTargetAtoms
Stefan Vogel <sv@exept.de>
parents: 5936
diff changeset
 13294
5473
d5687a021b55 __isByteArray() to __isByteArrayLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 5467
diff changeset
 13295
version_CVS
6573
fc119adc7582 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 6472
diff changeset
 13296
    ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.2 2014-09-25 21:16:16 stefan Exp $'
5746
1ba87f4f40ca Jan's changes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5741
diff changeset
 13297
!
1ba87f4f40ca Jan's changes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5741
diff changeset
 13298
1ba87f4f40ca Jan's changes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 5741
diff changeset
 13299
version_SVN
6064
1cc8b8daaff5 class: XWorkstation
Claus Gittinger <cg@exept.de>
parents: 6041
diff changeset
 13300
    ^ '$ Id $'
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
 13301
! !
3758
c484f793f9b1 selection change handling
Claus Gittinger <cg@exept.de>
parents: 3738
diff changeset
 13302
5979
c50771acccc6 class: XWorkstation
Stefan Vogel <sv@exept.de>
parents: 5974
diff changeset
 13303
295
08cd959204c7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
 13304
XWorkstation initialize!