1/* 2 Title: X-Windows/Motif Interface. 3 4 Copyright (c) 2000 5 Cambridge University Technical Services Limited 6 7 This library is free software; you can redistribute it and/or 8 modify it under the terms of the GNU Lesser General Public 9 License as published by the Free Software Foundation; either 10 version 2.1 of the License, or (at your option) any later version. 11 12 This library is distributed in the hope that it will be useful, 13 but WITHOUT ANY WARRANTY; without even the implied warranty of 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 Lesser General Public License for more details. 16 17 You should have received a copy of the GNU Lesser General Public 18 License along with this library; if not, write to the Free Software 19 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 20 21*/ 22 23#ifdef HAVE_CONFIG_H 24#include "config.h" 25#elif defined(_WIN32) 26#include "winconfig.h" 27#else 28#error "No configuration file" 29#endif 30 31#if (defined(WITH_XWINDOWS)) 32// X-Windows is required. 33 34/* xwindows.c */ 35 36/* Removed indirection from get_C_* functions SPF 31/10/93 */ 37/* Added Handle type 2/11/93 */ 38/* Fixed "GetString can only be used once" bug 17/11/93 */ 39 40/* Dealing with gcc warning messages SPF 6/1/94 */ 41/* Retrofit to old Sun cc SPF 7/1/94 */ 42/* 25/1/94 SPF Fixed bug in EmptyVisual (core-dump when v==NULL) */ 43 44/* Comment added 4/11/93 SPF 45 46Global Invariants: 47 48(1) Get functions promise not to allocate on the Poly/ML heap 49 50(2) The Poly/ML heap contains pointers into the C heap! 51 As these are only valid for one session, the run-time 52 system records which Poly/ML objects have been created 53 in the current session. Only these objects contain 54 valid C pointers, and so may be dereferenced. 55 56 The "bad" Poly/ML objects are: 57 58Flags Object Bad Field Access Function 59----- ------ --------- --------------- 60M X_GC_Object GC *gc GetGC 61 X_Font_Object Font *font GetFont 62 ditto XFontStruct **fs GetFS 63 X_Cursor_Object Cursor *cursor GetCursor 64BM X_Window_Object Drawable *drawable GetDrawable, GetPixmap 65 X_Pixmap_Object Pixmap *pixmap GetDrawable, GetPixmap 66 X_Colormap_Object Colormap *cmap GetColormap 67 X_Visual_Object Visual **visual GetVisual (* FISHY *) 68B X_Display_Object Display *display (?) GetDisplay (?) 69 ditto XtAppContext app_context NONE(?) 70M X_Widget_Object Widget *widget GetWidget, GetNWidget 71B X_Trans_Object XtTranslations table GetTrans 72B X_Acc_Object XtAccelerators acc GetAcc 73 74 WARNING: the above list of unsafe fields was created by SPF 75 and may be incomplete. 76 77 The function CheckExists should be called on these objects 78 before it is safe to use any of the above fields. That's 79 because the object may have been created in a previous ML 80 session, so the pointers that it contains may no longer be 81 valid. Using the appropriate access function listed above 82 guarantees that CheckExists is called. 83 84 Exception: the fields can safely be tested against C's zero 85 (None, Null) even if CheckExists hasn't been called. Note that 86 this is only database-safe because this value is used for 87 uninitialised fields, so it doesn't confuse the garbage-collector. 88 89 For all the above fields EXCEPT display, app_context, table, acc 90 the run-time system creates an indirection object in the Poly heap. 91 These fields don't need an indirection object because the object 92 which contains them is itself a BYTE object. 93 94 This indirection is a byte-object. The indirection is necessary 95 because the garbage collector would object to finding a C pointer 96 in a standard ML labelled record. The alternative would be to store 97 the C pointer as an ML integer, but then we would have to convert 98 back to a C pointer befor we could dereference it. 99 100 For similar reasons, eventMask is also stored as a boxed PolyWord. 101 102 abstype Colormap = Colormap with end; (* X_Colormap_Object *) 103 abstype Cursor = Cursor with end; (* X_Cursor_Object *) 104 abstype Drawable = Drawable with end; (* X_Window_Object, XPixmap_Object *) 105 abstype Font = Font with end; (* X_Font_Object *) 106 abstype GC = GC with end; (* X_GC_Object *) 107 abstype Visual = Visual with end; (* X_Visual_Object *) 108 abstype Display = Display with end; (* X_Display_Object *) 109 110 abstype Widget = Widget of int with end; 111 abstype XtAccelerators = XtAccelerators of int with end; 112 abstype XtTranslations = XtTranslations of int with end; 113*/ 114 115 116 117/* MLXPoint, MLXRectangle, MLXArc, MLPair, MLTriple added 31/10/93 SPF */ 118 119#ifdef HAVE_STDIO_H 120#include <stdio.h> 121#endif 122 123#ifdef HAVE_SYS_TYPES_H 124#include <sys/types.h> 125#endif 126 127#ifdef HAVE_SYS_TIME_H 128#include <sys/time.h> 129#endif 130 131#ifdef HAVE_SIGNAL_H 132#include <signal.h> 133#endif 134 135#ifdef HAVE_STDLIB_H 136#include <stdlib.h> 137#endif 138 139#ifdef HAVE_FCNTL_H 140#include <fcntl.h> 141#endif 142 143#ifdef HAVE_CTYPE_H 144#include <ctype.h> 145#endif 146 147#ifdef HAVE_STDLIB_H 148#include <stdlib.h> 149#endif 150 151#ifdef HAVE_ASSERT_H 152#include <assert.h> 153#endif 154 155#ifdef HAVE_UNISTD_H 156#include <unistd.h> 157#endif 158 159#ifdef HAVE_ALLOCA_H 160#include <alloca.h> 161#endif 162 163#ifdef HAVE_ERRNO_H 164#include <errno.h> 165#endif 166 167/* what goes wrong? ... gid, fd, private15 inaccessible */ 168/* THIS NEEDS TO BE FIXED!!!! */ 169#define XLIB_ILLEGAL_ACCESS 1 /* We need access to some opaque structures */ 170 171/* use prototypes, but make sure we get Booleans, not ints */ 172#define NeedWidePrototypes 0 173 174#include <X11/Xlib.h> 175 176#include <X11/keysym.h> /* IsCursorKey, IsFunctionKey, et cetera */ 177#include <X11/Xproto.h> /* needed for protocol names such as X_CreateWindow */ 178#include <X11/Xatom.h> /* XA_ATOM, et cetera */ 179 180#include <Xm/Xm.h> 181#include <Xm/ArrowB.h> 182#include <Xm/ArrowBG.h> 183#include <Xm/BulletinB.h> 184#include <Xm/CascadeB.h> 185#include <Xm/CascadeBG.h> 186#include <Xm/Command.h> 187#include <Xm/DialogS.h> 188#include <Xm/DrawingA.h> 189#include <Xm/DrawnB.h> 190#include <Xm/FileSB.h> 191#include <Xm/Form.h> 192#include <Xm/Frame.h> 193#include <Xm/Label.h> 194#include <Xm/LabelG.h> 195#include <Xm/List.h> 196#include <Xm/MainW.h> 197#include <Xm/MenuShell.h> 198#include <Xm/MessageB.h> 199#include <Xm/PanedW.h> 200#include <Xm/PushB.h> 201#include <Xm/PushBG.h> 202#include <Xm/RowColumn.h> 203#include <Xm/Scale.h> 204#include <Xm/ScrollBar.h> 205#include <Xm/ScrolledW.h> 206#include <Xm/SelectioB.h> 207#include <Xm/SeparatoG.h> 208#include <Xm/Separator.h> 209#include <Xm/Text.h> 210#include <Xm/TextF.h> 211#include <Xm/ToggleB.h> 212#include <Xm/ToggleBG.h> 213 214/* Motif 1.2 */ 215#include <Xm/VendorS.h> 216/* for XmIsDesktopObject */ 217#include <Xm/DesktopP.h> 218/* for XmIsExtObject */ 219#include <Xm/ExtObjectP.h> 220/* for XmIsShellExt */ 221#include <Xm/ShellEP.h> 222/* for XmIsVendorShellExt */ 223#include <Xm/VendorSEP.h> 224#if(0) 225/* for XmIsWorldObject */ 226/* This is not supported in FreeBSD or Solaris 8. */ 227#include <Xm/WorldP.h> 228#endif 229 230#include "globals.h" 231#include "sys.h" 232#include "xwindows.h" 233 234#include "run_time.h" 235#include "arb.h" 236#include "mpoly.h" 237#include "gc.h" 238#include "xcall_numbers.h" 239#include "diagnostics.h" 240#include "processes.h" 241#include "save_vec.h" 242#include "polystring.h" 243#include "scanaddrs.h" 244#include "memmgr.h" 245#include "machine_dep.h" 246#include "processes.h" 247#include "rts_module.h" 248#include "rtsentry.h" 249 250extern "C" { 251 POLYEXTERNALSYMBOL POLYUNSIGNED PolyXWindowsGeneral(PolyObject *threadId, PolyWord params); 252} 253/* The following are only forward so we can declare attributes */ 254static void RaiseXWindows(TaskData *taskData, const char *s) __attribute__((noreturn)); 255 256 257#define ButtonClickMask (((unsigned)1 << 29)) 258 259#define XMASK(m) ((m) &~ButtonClickMask) 260 261#undef SIZEOF 262 263#define debug1(fmt,p1) { /*EMPTY*/ } 264#undef debug1 265#define debug1(fmt,p1) {if (debugOptions & DEBUG_X) printf(fmt,p1);} 266#define debug3(fmt,p1,p2,p3) {if (debugOptions & DEBUG_X) printf(fmt,p1,p2,p3);} 267 268#define debugCreate(type,value) debug1("%lx " #type " created\n",(unsigned long)(value)) 269#define debugReclaim(type,value) debug1("%lx " #type " reclaimed\n",(unsigned long)(value)) 270#define debugReclaimRef(type,value) debug1("%lx " #type " reference reclaimed\n",(unsigned long)(value)) 271#define debugRefer(type,value) debug1("%lx " #type " referenced\n",(unsigned long)(value)) 272#define debugCreateCallback(MLValue,CValue,CListCell) debug3("%p Widget callback reference created (%p,%p)\n",CValue,CListCell,MLValue) 273#define debugReclaimCallback(MLValue,CValue,CListCell) debug3("%p Widget callback reference removed (%p,%p)\n",CValue,CListCell,MLValue) 274 275 276/* forward declarations */ 277 278static Atom WM_DELETE_WINDOW(Display *d); /* was int SPF 6/1/94 */ 279 280#define DEREFDISPLAYHANDLE(h) ((X_Display_Object *)DEREFHANDLE(h)) 281#define DEREFWINDOWHANDLE(h) ((X_Window_Object *)DEREFHANDLE(h)) 282#define DEREFXOBJECTHANDLE(h) ((X_Object *)DEREFHANDLE(h)) 283 284#define SAVE(x) taskData->saveVec.push(x) 285 286#define Make_int(x) Make_arbitrary_precision(taskData, x) 287#define Make_string(s) SAVE(C_string_to_Poly(taskData, s)) 288#define Make_bool(b) Make_arbitrary_precision(taskData, (b) != 0) 289 290#define SIZEOF(x) (sizeof(x)/sizeof(PolyWord)) 291 292#define min(a,b) (a < b ? a : b) 293#define max(a,b) (a > b ? a : b) 294 295#define ISNIL(p) (ML_Cons_Cell::IsNull(p)) 296#define NONNIL(p) (!ISNIL(p)) 297 298typedef Handle EventHandle; 299 300 301/********************************************************************************/ 302/* Objects are created MUTABLE and are FINISHED when all their fields have been */ 303/* filled in (assuming they are immutable objects). This is so that we can */ 304/* consider the possibility of storing immutable objects in read-only memory */ 305/* segments (not currently implemented). SPF 7/12/93 */ 306/********************************************************************************/ 307static Handle FINISHED(TaskData *taskData, Handle P) 308{ 309 PolyObject *pt = DEREFHANDLE(P); 310 assert(taskData->saveVec.isValidHandle(P)); 311 assert(pt->IsMutable()); 312 POLYUNSIGNED lengthW = pt->LengthWord(); 313 pt->SetLengthWord(lengthW & ~_OBJ_MUTABLE_BIT); 314 return P; 315} 316 317 318static void RaiseXWindows(TaskData *taskData, const char *s) 319{ 320 if (mainThreadPhase == MTP_USER_CODE) 321 { 322 raise_exception_string(taskData, EXC_XWindows,s); 323 } 324 else 325 { 326 /* Crash added 7/7/94 SPF */ 327 Crash("Tried to raise exception (XWindows \"%s\") during garbage collection\n",s); 328 } 329 /*NOTREACHED*/ 330} 331 332 333/* bugfixed 6/12/94 SPF */ 334#define RaiseXWindows2(varmessage,constmessage) \ 335{ \ 336 const char message[] = constmessage; \ 337 int n1 = strlen(varmessage); \ 338 int n2 = strlen(message); \ 339 char *mess = (char *)alloca(n1 + n2 + 1); \ 340 strcat(strncpy(mess,varmessage,n1),message); \ 341 RaiseXWindows(taskData, mess); \ 342 /*NOTREACHED*/ \ 343} 344 345static void RaiseRange(TaskData *taskData) 346{ 347 raise_exception0(taskData, EXC_size); 348} 349 350typedef unsigned char uchar; 351 352static uchar get_C_uchar(TaskData *taskData, PolyWord a) 353{ 354 unsigned u = get_C_ushort(taskData, a); 355 356 if (u >= 256) RaiseRange(taskData); 357 358 return u; 359} 360 361 362/******************************************************************************/ 363/* */ 364/* String */ 365/* */ 366/******************************************************************************/ 367 368//#define String PolyStringObject 369 370//#define GetString(s) _GetString((PolyWord *)(s)) 371/* can only be called TABLESIZE times per X opcode */ 372static PolyStringObject *GetString(PolyWord s) 373{ 374#define TABLESIZE 5 375 static PolyStringObject string[TABLESIZE]; 376 static int index = 0; 377 378 if (! s.IsTagged()) return (PolyStringObject *) s.AsObjPtr(); 379 380 index = (index + 1) % TABLESIZE; 381 string[index].length = 1; 382 string[index].chars[0] = UNTAGGED(s); 383 384 return &string[index]; 385#undef TABLESIZE 386} 387 388 389/******************************************************************************/ 390/* */ 391/* XObjects (Type definitions) */ 392/* */ 393/******************************************************************************/ 394 395/* We keep a list of all objects created by calls to X. */ 396/* When an object is created we add an entry to the list and */ 397/* return the entry. If the entry becomes inaccessible */ 398/* by the garbage collector then we free the object. */ 399/* The list is created by malloc so that it is not in the heap. */ 400 401 402// Types of objects. These are tagged when they are stored 403// in objects because some objects are not byte objects. 404typedef enum 405{ 406 X_GC = 111, 407 X_Font = 222, 408 X_Cursor = 333, 409 X_Window = 444, 410 X_Pixmap = 555, 411 X_Colormap = 666, 412 X_Visual = 777, 413 X_Display = 888, 414 X_Widget = 999, 415 X_Trans = 1111, 416 X_Acc = 2222 417} X_types; 418 419class X_Object: public PolyObject 420{ 421public: 422 X_Object(): type(TAGGED(1)) {} // Just to keep gcc happy 423 PolyWord type; 424}; 425 426class X_Trans_Object: public X_Object /* BYTE object */ 427{ 428public: 429 XtTranslations table; /* C value */ 430}; 431 432class X_Acc_Object: public X_Object /* BYTE object */ 433{ 434public: 435 XtAccelerators acc; /* C value */ 436}; 437 438class X_Display_Object: public X_Object /* BYTE object */ 439{ 440public: 441 Display *display; /* C value */ 442 unsigned screen; /* C value */ 443 XtAppContext app_context; /* C value */ 444} ; 445 446class X_Font_Object: public X_Object 447{ 448public: 449 Font *font; /* Token for C value */ 450 XFontStruct **fs; /* Token for C value */ 451 X_Display_Object *ds; /* Token */ 452} ; 453 454class X_Cursor_Object: public X_Object 455{ 456public: 457 Cursor *cursor; /* Token for C value */ 458 X_Display_Object *ds; /* Token */ 459} ; 460 461class X_Pixmap_Object: public X_Object 462{ 463public: 464 Pixmap *pixmap; /* Token for C value */ 465 X_Display_Object *ds; /* Token */ 466} ; 467 468class X_Colormap_Object: public X_Object 469{ 470public: 471 Colormap *cmap; /* Token for C value */ 472 X_Display_Object *ds; /* Token */ 473} ; 474 475class X_Widget_Object: public X_Object /* MUTABLE */ 476{ 477public: 478 Widget *widget; /* Token for C value */ 479 PolyWord callbackList; /* mutable */ 480 PolyWord state; /* mutable */ 481 X_Display_Object *ds; /* Token */ 482} ; 483 484class X_Visual_Object: public X_Object 485{ 486public: 487 Visual **visual; /* Token for C value */ 488 X_Display_Object *ds; /* Token */ 489} ; 490 491class X_GC_Object: public X_Object /* MUTABLE */ 492{ 493public: 494 GC *gc; /* Token for C value */ 495 X_Font_Object *font_object; /* mutable; may be 0 */ 496 X_Pixmap_Object *tile; /* mutable; may be 0 */ 497 X_Pixmap_Object *stipple; /* mutable; may be 0 */ 498 X_Pixmap_Object *clipMask; /* mutable; may be 0 */ 499 X_Display_Object *ds; /* Token */ 500} ; 501 502class X_Window_Struct: public X_Object /* MUTABLE */ 503{ 504public: 505 Drawable *drawable; /* Token for C value */ 506 PolyWord handler; /* mutable? */ 507 PolyWord state; /* mutable? */ 508 PolyObject *eventMask; /* Token for C value; token itself is mutable */ 509 X_Colormap_Object *colormap_object; /* mutable; may be 0 */ 510 X_Cursor_Object *cursor_object; /* mutable; may be 0 */ 511 X_Pixmap_Object *backgroundPixmap; /* mutable; may be 0 */ 512 X_Pixmap_Object *borderPixmap; /* mutable; may be 0 */ 513 X_Window_Struct *parent; /* may be 0 */ 514 X_Display_Object *ds; /* Token */ 515}; 516 517typedef X_Window_Struct X_Window_Object; 518 519 520/******************************************************************************/ 521/* */ 522/* Forward declarations */ 523/* */ 524/******************************************************************************/ 525static Font GetFont(TaskData *taskData, X_Object *P); 526static Cursor GetCursor(TaskData *taskData,X_Object *P); 527static Colormap GetColormap(TaskData *taskData,X_Object *P); 528static Visual *GetVisual(TaskData *taskData,X_Object *P); 529static XtTranslations GetTrans(TaskData *taskData,X_Object *P); 530static XtAccelerators GetAcc(TaskData *taskData,X_Object *P); 531static Pixmap GetPixmap(TaskData *, X_Object *P); 532static Widget GetNWidget(TaskData *, X_Object *P); 533static Window GetWindow(TaskData *, X_Object *P); 534static Display *GetDisplay(TaskData *, X_Object *P); 535 536static void DestroyWindow(X_Object *W); 537static void DestroySubwindows(X_Object *W); 538 539static X_GC_Object *GCObject(X_Object *P); 540static X_Pixmap_Object *PixmapObject(X_Object *P); 541static X_Widget_Object *WidgetObject(TaskData *, X_Object *P); 542static X_Window_Object *WindowObject(X_Object *P); 543 544/******************************************************************************/ 545/* */ 546/* C lists (Type definitions) */ 547/* */ 548/******************************************************************************/ 549 550typedef struct X_List_struct X_List; 551 552struct X_List_struct 553{ 554 X_List *next; /* pointer into C heap */ 555 X_Object *object; /* pointer into Poly heap; weak */ 556}; 557 558typedef struct timeval TimeVal; 559 560/* In C heap */ 561typedef struct T_List_struct T_List; 562struct T_List_struct 563{ 564 T_List *next; /* pointer into C heap */ 565 TimeVal timeout; /* here */ 566 X_Window_Object *window_object; /* pointer into Poly heap, or 0; weak */ 567 X_Widget_Object *widget_object; /* pointer into Poly heap, or 0; strong */ 568 PolyObject *alpha; /* pointer into Poly heap; strong */ 569 PolyObject *handler; /* pointer into Poly heap; strong */ 570 int expired; /* here */ 571}; 572/* NB precisely one of window_object and widget_object should be non-zero */ 573 574/* In C heap */ 575typedef struct C_List_struct C_List; 576struct C_List_struct 577{ 578 PolyObject *function; /* pointer into Poly heap; strong */ 579 X_Widget_Object *widget_object; /* pointer into Poly heap; strong */ 580 C_List *next; /* pointer into C heap */ 581}; 582 583/* lists of X objects currently in Poly heap i.e. those created in this session */ 584#define XLISTSIZE 1001 /* must be coprime to 4 ('cos pointers are PolyWord-aligned) */ 585static X_List *XList[XLISTSIZE] = {0}; 586 587static T_List *TList = 0; /* C pending messages list, ordered by arrival time */ 588static C_List *CList = 0; /* Acts as root for objects "owned" by C callbacks */ 589static PolyWord FList = TAGGED(0); /* ML Callback list - acts as a Root for the Heap */ 590static PolyWord GList = TAGGED(0); /* ML Event list - acts as a Root for the Heap */ 591 592static Bool callbacks_enabled = False; 593 594 595 596/******************************************************************************/ 597/* */ 598/* High-speed XList routines */ 599/* */ 600/******************************************************************************/ 601 602/* maps an (X_Object *) to an (unsigned); this mapping from must give the same */ 603/* (unsigned) for each (X_Object) for an entire Poly/ML session, even though its */ 604/* address may change at every garbage collection. */ 605/* The way we achieve this is by returning the address of the corresponding C */ 606/* object. Note that since the ML object doesn't necessarily correspond to a real*/ 607/* C object, this value may be neither valid nor sensible (but it WILL be a */ 608/* constant). */ 609/* Unfortunately, we can't do this for GCs or VISUALS, since the actual C object */ 610/* contains the id we want, and we can't access the id if we haven't got the */ 611/* object. For these, we return a constant instead. */ 612static unsigned long hashId(X_Object *P) 613{ 614 615#define HASH_GC 0 616#define HASH_VISUAL 1 617 618 switch(UNTAGGED(P->type)) 619 { 620 case X_GC: return HASH_GC; 621 case X_Font: return (unsigned long)(*(((X_Font_Object*)P)->font)); 622 case X_Cursor: return (unsigned long)(*(((X_Cursor_Object*)P)->cursor)); 623 case X_Window: return (unsigned long)(*(((X_Window_Struct*)P)->drawable)); 624 case X_Pixmap: return (unsigned long)(*(((X_Pixmap_Object*)P)->pixmap)); 625 case X_Colormap: return (unsigned long)(*(((X_Colormap_Object*)P)->cmap)); 626 case X_Visual: return HASH_VISUAL; 627 case X_Display: return (unsigned long)(((X_Display_Object*)P)->display); 628 case X_Widget: return (unsigned long)(*(((X_Widget_Object*)P)->widget)); 629 case X_Trans: return (unsigned long)(((X_Trans_Object*)P)->table); 630 case X_Acc: return (unsigned long)(((X_Acc_Object*)P)->acc); 631 default: Crash ("Bad X_Object type (%d) in hashId",UNTAGGED(P->type)); 632 } 633 /*NOTREACHED*/ 634} 635 636static void initXList(void) 637{ 638 int i; 639 640 for (i = 0; i < XLISTSIZE; i++) 641 { 642 XList[i] = NULL; 643 } 644} 645 646static X_List **hashXList(X_Object *P) 647{ 648 unsigned long id = hashId(P); 649 unsigned n = (id % XLISTSIZE); /* a poor hash function, but good enough for now */ 650 return &(XList[n]); 651} 652 653static X_List *findXList(unsigned long id) 654{ 655 unsigned n = (id % XLISTSIZE); /* a poor hash function, but good enough for now */ 656 return XList[n]; 657} 658 659/******************************************************************************/ 660/* */ 661/* C lists (Polymorphic functions) */ 662/* */ 663/******************************************************************************/ 664// Creates a list from a vector of items. 665 666static Handle CreateList4(TaskData *taskData, unsigned n, void *p, unsigned objSize, Handle (*f)(TaskData *, void *)) 667{ 668 669 Handle saved = taskData->saveVec.mark(); 670 Handle list = SAVE(ListNull); 671 // Process the vector in reverse order. That way we can make the 672 // cells as immutable objects rather than having to create them as 673 // mutable and then lock them. 674 while (n) 675 { 676 n--; 677 byte *objP = (byte*)p + objSize*n; 678 Handle value = (* f)(taskData, objP); 679 Handle next = alloc_and_save(taskData, SIZEOF(ML_Cons_Cell)); 680 DEREFLISTHANDLE(next)->h = DEREFWORDHANDLE(value); 681 DEREFLISTHANDLE(next)->t = DEREFLISTHANDLE(list); 682 683 /* reset save vector to stop it overflowing */ 684 taskData->saveVec.reset(saved); 685 list = SAVE(DEREFHANDLE(next)); 686 } 687 688 return list; 689} 690 691static Handle CreateList4I(TaskData *taskData, unsigned n, void *p, unsigned objSize, 692 Handle (*f)(TaskData *, void *, unsigned i)) 693{ 694 695 Handle saved = taskData->saveVec.mark(); 696 Handle list = SAVE(ListNull); 697 while (n) 698 { 699 n--; 700 byte *objP = (byte*)p + objSize*n; 701 Handle value = (* f)(taskData, objP, n); 702 Handle next = alloc_and_save(taskData, SIZEOF(ML_Cons_Cell)); 703 DEREFLISTHANDLE(next)->h = DEREFWORDHANDLE(value); 704 DEREFLISTHANDLE(next)->t = DEREFLISTHANDLE(list); 705 706 /* reset save vector to stop it overflowing */ 707 taskData->saveVec.reset(saved); 708 list = SAVE(DEREFHANDLE(next)); 709 } 710 711 return list; 712} 713 714static Handle CreateList5(TaskData *taskData, POLYUNSIGNED n, void *p, POLYUNSIGNED objSize, 715 Handle (*f)(TaskData *, void *, Handle), Handle a1) 716{ 717 Handle saved = taskData->saveVec.mark(); 718 Handle list = SAVE(ListNull); 719 // Process the vector in reverse order. That way we can make the 720 // cells as immutable objects rather than having to create them as 721 // mutable and then lock them. 722 while (n) 723 { 724 n--; 725 byte *objP = (byte*)p + objSize*n; 726 Handle value = (* f)(taskData, objP, a1); 727 Handle next = alloc_and_save(taskData, SIZEOF(ML_Cons_Cell)); 728 DEREFLISTHANDLE(next)->h = DEREFWORDHANDLE(value); 729 DEREFLISTHANDLE(next)->t = DEREFLISTHANDLE(list); 730 731 /* reset save vector to stop it overflowing */ 732 taskData->saveVec.reset(saved); 733 list = SAVE(DEREFHANDLE(next)); 734 } 735 736 return list; 737} 738 739static void GetList4(TaskData *taskData, PolyWord list, void *v, unsigned bytes, 740 void (*get)(TaskData *, PolyWord, void*, unsigned)) 741{ 742 unsigned i = 0; 743 byte *s = (byte*)v; 744 745 for(PolyWord p = list; NONNIL(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) 746 { 747 (* get)(taskData, ((ML_Cons_Cell*)p.AsObjPtr())->h, s, i); 748 s += bytes; 749 i++; 750 } 751} 752 753/* ListLength no longer requires indirection via handle SPF 4/11/93 */ 754static unsigned ListLength(PolyWord list) 755{ 756 unsigned n = 0; 757 758 for(PolyWord p = list; NONNIL(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) n++; 759 760 return n; 761} 762 763/******************************************************************************/ 764/* */ 765/* TList Purge Functions (SPF 29/11/93) */ 766/* */ 767/******************************************************************************/ 768static void PurgePendingWidgetMessages(X_Widget_Object *P) 769{ 770 T_List **T = &TList; 771 772 while(*T) 773 { 774 T_List *t = *T; 775 776 if (t->widget_object == P) /* clear out pending messages for this widget */ 777 { 778 *T = t->next; 779 free(t); 780 } 781 else T = &t->next; 782 } 783} 784 785static void PurgePendingWindowMessages(X_Window_Object *P) 786{ 787 T_List **T = &TList; 788 789 while(*T) 790 { 791 T_List *t = *T; 792 793 if (t->window_object == P) /* clear out pending messages for this window */ 794 { 795 *T = t->next; 796 free(t); 797 } 798 else T = &t->next; 799 } 800} 801 802/******************************************************************************/ 803/* */ 804/* CList Purge Functions (SPF 29/2/96) */ 805/* */ 806/******************************************************************************/ 807static void PurgeCCallbacks(X_Widget_Object *P, Widget w) 808{ 809 C_List **C = &CList; 810 811 while(*C) 812 { 813 C_List *c = *C; 814 815 if (c->widget_object == P) /* clear out callback info for this widget */ 816 { 817 debugReclaimCallback(P,w,c); 818 *C = c->next; 819 free(c); 820 } 821 else C = &c->next; 822 } 823} 824 825/******************************************************************************/ 826/* */ 827/* XObjects (Polymorphic functions 1) */ 828/* */ 829/******************************************************************************/ 830static int ResourceExists(X_Object *P) 831{ 832 X_List *L; 833 834 for(L = *hashXList(P); L; L = L->next) 835 { 836 if (L->object == P) return 1; 837 } 838 839 return 0; 840} 841 842/* SafeResourceExists is like ResourceExists but doesn't assume that 843 we actually have a valid X object, so it doesn't use hashing. 844 SPF 6/4/95 */ 845static int SafeResourceExists(X_Object *P) 846{ 847 unsigned n; 848 849 for (n = 0; n < XLISTSIZE; n++) 850 { 851 X_List *L; 852 853 for(L = XList[n]; L; L = L->next) 854 { 855 if (L->object == P) return 1; 856 } 857 } 858 return 0; 859} 860 861static void DestroyXObject(X_Object *P) 862{ 863 TaskData *taskData = processes->GetTaskDataForThread(); 864 865 X_List **X = hashXList(P); 866 867 switch(UNTAGGED(P->type)) 868 { 869 case X_GC: 870 { 871 X_GC_Object *G = GCObject(P); 872 873 GC gc = *G->gc; 874 Display *d = G->ds->display; 875 876 if (gc == DefaultGC(d,G->ds->screen)) 877 { 878 debugReclaimRef(GC,gc->gid); 879 } 880 else 881 { 882 debugReclaim(GC,gc->gid); 883 XFreeGC(d,gc); /* SAFE(?) */ 884 } 885 break; 886 } 887 888 case X_Font: 889 { 890 Font f = GetFont(taskData, P); 891 892 if (f == None) 893 { 894 debugReclaimRef(Font,f); 895 } 896 else 897 { 898 debugReclaim(Font,f); 899 900#if NEVER 901 XUnloadFont(GetDisplay(taskData, P),f); 902#endif 903 } 904 break; 905 } 906 907 case X_Cursor: 908 { 909 Cursor cursor = GetCursor(taskData, P); 910 911 if (cursor == None) 912 { 913 debugReclaimRef(Cursor,cursor); 914 } 915 else 916 { 917 debugReclaim(Cursor,cursor); 918 919#if NEVER 920 XFreeCursor(GetDisplay(taskData, P),cursor); 921#endif 922 } 923 924 break; 925 } 926 927 case X_Window: 928 { 929 /* added 29/11/93 SPF */ 930 PurgePendingWindowMessages(WindowObject(P)); 931 932 if (((X_Window_Object *)P)->parent != 0) /* this clients window */ 933 { 934 debugReclaim(Window,GetWindow(taskData, P)); 935 DestroyWindow(P); 936 } 937 else /* None, ParentRelative, and other clients windows */ 938 { 939 debugReclaimRef(Window,GetWindow(taskData, P)); 940 } 941 break; 942 } 943 944 case X_Pixmap: 945 { 946 Pixmap pixmap = GetPixmap(taskData, P); 947 948 if (pixmap == None) 949 { 950 debugReclaimRef(Pixmap,pixmap); 951 } 952 else 953 { 954 debugReclaim(Pixmap,pixmap); 955 956#if NEVER 957 XFreePixmap(GetDisplay(taskData, P),pixmap); 958#endif 959 } 960 961 break; 962 } 963 964 case X_Colormap: 965 { 966 Colormap cmap = GetColormap(taskData, P); 967 968 if (cmap == None) 969 { 970 debugReclaimRef(Colormap,cmap); 971 } 972 else 973 { 974 debugReclaim(Colormap,cmap); 975#if NEVER 976 XFreeColormap(GetDisplay(taskData, P),cmap); 977#endif 978 } 979 break; 980 } 981 982 case X_Visual: 983 { 984 Visual *visual = GetVisual(taskData, P); 985 986 debugReclaimRef(Visual,visual->visualid); 987 break; 988 } 989 990 case X_Widget: 991 { 992 Widget widget = GetNWidget(taskData, P); 993 994 PurgePendingWidgetMessages(WidgetObject(taskData, P)); 995 debugReclaimRef(Widget,widget); 996 break; 997 } 998 999 case X_Trans: 1000 { 1001 XtTranslations table = GetTrans(taskData, P); 1002 1003 debugReclaimRef(Trans,table); 1004 break; 1005 } 1006 1007 case X_Acc: 1008 { 1009 XtAccelerators acc = GetAcc(taskData, (X_Object *)P); 1010 1011 debugReclaimRef(Acc,acc); 1012 break; 1013 } 1014 1015 default: Crash ("Unknown X_Object type %d",UNTAGGED(P->type)); 1016 } 1017 1018 while(*X) 1019 { 1020 X_List *L = *X; 1021 1022 if (L->object == P) 1023 { 1024 *X = L->next; 1025 free(L); 1026 return; 1027 } 1028 else X = &L->next; 1029 } 1030 printf("DestroyXObject: destroy failed\n"); 1031} 1032 1033#define CheckExists(P,resource) \ 1034{\ 1035 if (! ResourceExists(P)) RaiseXWindows(taskData, (char*) "Non-existent " #resource); \ 1036} 1037 1038static X_Font_Object *FontObject(X_Object *P) 1039{ 1040 assert(UNTAGGED(P->type) == X_Font); 1041 1042 return (X_Font_Object *)P; 1043} 1044 1045static X_Object *FindResource 1046( 1047 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1048 X_types type, 1049 unsigned long id, 1050 unsigned long hashid 1051) 1052{ 1053 X_List *L; 1054 X_Display_Object *d = (type == X_Widget) ? NULL : DEREFDISPLAYHANDLE(dsHandle); 1055 1056 for(L = findXList(hashid); L; L = L->next) 1057 { 1058 X_Object *P = L->object; 1059 1060 if (UNTAGGED(P->type) == type) 1061 { 1062 switch(type) 1063 { 1064 case X_GC: if (((X_GC_Object*)P)->ds == d && (*((X_GC_Object*)P)->gc)->gid == id) return P; break; 1065 case X_Font: if (((X_Font_Object*)P)->ds == d && (*((X_Font_Object*)P)->font) == id) return P; break; 1066 case X_Cursor: if (((X_Cursor_Object*)P)->ds == d && (*((X_Cursor_Object*)P)->cursor) == id) return P; break; 1067 case X_Window: if (((X_Window_Object*)P)->ds == d && (*((X_Window_Object*)P)->drawable) == id) return P; break; 1068 case X_Pixmap: if (((X_Pixmap_Object*)P)->ds == d && (*((X_Pixmap_Object*)P)->pixmap) == id) return P; break; 1069 case X_Colormap: if (((X_Colormap_Object*)P)->ds == d && (*((X_Colormap_Object*)P)->cmap) == id) return P; break; 1070 case X_Visual: if (((X_Visual_Object*)P)->ds == d && (*((X_Visual_Object*)P)->visual)->visualid == id) return P; break; 1071 1072 case X_Widget: if (*(((X_Widget_Object*)P)->widget) == (Widget) id) return P; break; 1073 1074 case X_Display: break; 1075 case X_Trans: break; 1076 case X_Acc: break; 1077 1078 default: Crash ("Bad X_Object type (%d) in FindResource", type); 1079 } 1080 } 1081 } 1082 1083 return 0; 1084} 1085 1086// Why are there these casts to unsigned here???? 1087#define FindWindow(d,id) ((X_Window_Object *) FindResource(d,X_Window,(unsigned long)id,(unsigned long)id)) 1088#define FindPixmap(d,id) ((X_Pixmap_Object *) FindResource(d,X_Pixmap,(unsigned long)id,(unsigned long)id)) 1089#define FindCursor(d,id) ((X_Cursor_Object *) FindResource(d,X_Cursor,(unsigned long)id,(unsigned long)id)) 1090#define FindFont(d,id) ((X_Font_Object *) FindResource(d,X_Font,(unsigned long)id,(unsigned long)id)) 1091#define FindColormap(d,id) ((X_Colormap_Object *) FindResource(d,X_Colormap,(unsigned long)id,(unsigned long)id)) 1092#define FindWidget(id) ((X_Widget_Object *) FindResource((Handle)NULL,X_Widget,(unsigned long)id,(unsigned long)id)) 1093 1094/* can't use id for hashing in the following, so use arbitrary values instead */ 1095#define FindGC(d,id) ((X_GC_Object *) FindResource(d,X_GC,(unsigned long)id,HASH_GC)) 1096#define FindVisual(d,id) ((X_Visual_Object *) FindResource(d,X_Visual,(unsigned long)id,HASH_VISUAL)) 1097 1098static Handle AddXObject(Handle objectHandle) 1099{ 1100 X_List **X = hashXList(DEREFXOBJECTHANDLE(objectHandle)); 1101 X_List *L = (X_List *) malloc(sizeof(X_List)); 1102 1103 L->next = *X; 1104 L->object = (X_Object *)DEREFHANDLE(objectHandle); 1105 1106 *X = L; 1107 1108 return objectHandle; 1109} 1110 1111/******************************************************************************/ 1112/* */ 1113/* MLXPoint - implements ML XPoint datatype */ 1114/* */ 1115/******************************************************************************/ 1116typedef struct /* depends on XPoint datatype + ML compiler hash function */ 1117{ 1118 PolyWord x; /* ML int */ 1119 PolyWord y; /* ML int */ 1120} MLXPoint; 1121 1122inline MLXPoint * Point(PolyWord p) { return (MLXPoint *) p.AsObjPtr(); } 1123 1124/* shouldn't these be long values? */ 1125inline short GetPointX(TaskData *taskData, PolyWord p) { return get_C_short(taskData, Point(p)->x); } 1126inline short GetPointY(TaskData *taskData, PolyWord p) { return get_C_short(taskData, Point(p)->y); } 1127 1128inline short GetOffsetX(TaskData *taskData, PolyWord p) { return get_C_ushort(taskData, Point(p)->x); } 1129inline short GetOffsetY(TaskData *taskData, PolyWord p) { return get_C_ushort(taskData, Point(p)->y); } 1130 1131static Handle CreatePoint(TaskData *taskData, int x, int y) 1132{ 1133 Handle pointHandle = alloc_and_save(taskData, SIZEOF(MLXPoint), F_MUTABLE_BIT); 1134 1135/* Still allocating, so must use explicit DEREF for each element */ 1136#define point ((MLXPoint *)DEREFHANDLE(pointHandle)) 1137 point->x = DEREFWORD(Make_int(x)); 1138 point->y = DEREFWORD(Make_int(y)); 1139#undef point 1140 1141 return FINISHED(taskData, pointHandle); 1142} 1143 1144static void GetPoints(TaskData *taskData, PolyWord p, void *v, unsigned) 1145{ 1146 XPoint *A = (XPoint *)v; 1147 A->x = GetPointX(taskData, p); 1148 A->y = GetPointY(taskData, p); 1149} 1150 1151/******************************************************************************/ 1152/* */ 1153/* MLXRectangle - implements ML XRectangle datatype */ 1154/* */ 1155/******************************************************************************/ 1156 1157typedef struct /* depends on XRectangle datatype + ML compiler hash function */ 1158{ 1159 PolyWord top; /* ML int */ 1160 PolyWord left; /* ML int */ 1161 PolyWord right; /* ML int */ 1162 PolyWord bottom; /* ML int */ 1163} MLXRectangle; 1164 1165inline MLXRectangle *Rect(PolyWord R) { return (MLXRectangle *) R.AsObjPtr(); } 1166 1167inline short GetRectTop(TaskData *taskData, PolyWord R) { return get_C_short(taskData, Rect(R)->top); } 1168inline short GetRectLeft(TaskData *taskData, PolyWord R) { return get_C_short(taskData, Rect(R)->left); } 1169inline short GetRectRight(TaskData *taskData, PolyWord R) { return get_C_short(taskData, Rect(R)->right); } 1170inline short GetRectBottom(TaskData *taskData, PolyWord R) { return get_C_short(taskData, Rect(R)->bottom); } 1171 1172#define GetRectX(taskData, R) GetRectLeft(taskData, R) 1173#define GetRectY(taskData, R) GetRectTop(taskData, R) 1174 1175/* functions added 29/10/93 SPF */ 1176static unsigned GetRectW(TaskData *taskData, PolyWord R) 1177{ 1178 long result = GetRectRight(taskData, R) - GetRectLeft(taskData, R); 1179 1180 if (result < 0) RaiseRange(taskData); 1181 return (unsigned)result; 1182} 1183 1184static unsigned GetRectH(TaskData *taskData, PolyWord R) 1185{ 1186 long result = GetRectBottom(taskData, R) - GetRectTop(taskData, R); 1187 1188 if (result < 0) RaiseRange(taskData); 1189 return (unsigned)result; 1190} 1191 1192/* static MLXRectangle **CreateRect(top,left,bottom,right) */ 1193static Handle CreateRect(TaskData *taskData, int top, int left, int bottom, int right) 1194{ 1195 Handle rectHandle = alloc_and_save(taskData, SIZEOF(MLXRectangle), F_MUTABLE_BIT); 1196 1197/* Still allocating, so must use explicit DEREF for each element */ 1198#define rect ((MLXRectangle *)DEREFHANDLE(rectHandle)) 1199 rect->top = DEREFWORD(Make_int(top)); 1200 rect->left = DEREFWORD(Make_int(left)); 1201 rect->right = DEREFWORD(Make_int(right)); 1202 rect->bottom = DEREFWORD(Make_int(bottom)); 1203#undef rect 1204 1205 return FINISHED(taskData, rectHandle); 1206} 1207 1208#define CreateArea(w,h) CreateRect(taskData, 0,0,(int)h,(int)w) 1209 1210static void GetRects(TaskData *taskData, PolyWord p, void *v, unsigned) 1211{ 1212 XRectangle *A = (XRectangle *)v; 1213 A->x = GetRectX(taskData, p); 1214 A->y = GetRectY(taskData, p); 1215 A->width = GetRectW(taskData, p); 1216 A->height = GetRectH(taskData, p); 1217} 1218 1219static void CheckZeroRect(TaskData *taskData, PolyWord R) 1220{ 1221 unsigned x = GetRectX(taskData, R); 1222 unsigned y = GetRectY(taskData, R); 1223 unsigned w = GetRectW(taskData, R); 1224 unsigned h = GetRectH(taskData, R); 1225 1226 if (x != 0 || y != 0 || 1227/* w <= 0 || h <= 0 || w,h now unsigned SPF 29/10/93 */ 1228 w == 0 || h == 0 || 1229 w > 65535 || h > 65535) RaiseRange(taskData); 1230} 1231 1232 1233/******************************************************************************/ 1234/* */ 1235/* MLXArc - implements ML XArc datatype */ 1236/* */ 1237/******************************************************************************/ 1238 1239/* MLXArc added 31/10/93 SPF; depends on ML XArc datatype */ 1240typedef struct 1241{ 1242 PolyWord r; /* MMLXRectangle* */ 1243 PolyWord a1; /* ML int */ 1244 PolyWord a2; /* ML int */ 1245} MLXArc; 1246 1247inline MLXArc *Arc(PolyWord A) { return (MLXArc *) A.AsObjPtr(); } 1248 1249inline PolyWord GetArcR(PolyWord A) { return Arc(A)->r; } 1250inline short GetArcA1(TaskData *taskData, PolyWord A) { return get_C_short(taskData, Arc(A)->a1); } 1251inline short GetArcA2(TaskData *taskData, PolyWord A) { return get_C_short(taskData, Arc(A)->a2); } 1252 1253static void GetArcs(TaskData *taskData, PolyWord p, void *v, unsigned) 1254{ 1255 XArc *A = (XArc *)v; 1256 A->x = GetRectX(taskData, GetArcR(p)); 1257 A->y = GetRectY(taskData, GetArcR(p)); 1258 A->width = GetRectW(taskData, GetArcR(p)); 1259 A->height = GetRectH(taskData, GetArcR(p)); 1260 A->angle1 = GetArcA1(taskData, p); 1261 A->angle2 = GetArcA2(taskData, p); 1262} 1263 1264 1265/******************************************************************************/ 1266/* */ 1267/* Colormap */ 1268/* */ 1269/******************************************************************************/ 1270 1271static X_Colormap_Object *ColormapObject(X_Object *P) 1272{ 1273 assert(UNTAGGED(P->type) == X_Colormap); 1274 1275 return (X_Colormap_Object *)P; 1276} 1277 1278static Colormap GetColormap(TaskData *taskData, X_Object *P) 1279{ 1280 assert(UNTAGGED(P->type) == X_Colormap); 1281 1282 /* val NoColormap = xcall (23,0) : Colormap; */ 1283 /* special case for NoColormap - correct(?) */ 1284 if ( *(((X_Colormap_Object *)P)->cmap) == None) return None; 1285 1286 CheckExists(P,colormap); 1287 1288 return *(((X_Colormap_Object *)P)->cmap); 1289} 1290 1291static Handle EmptyColormap 1292( 1293 TaskData *taskData, 1294 Handle dsHandle /* Handle to (X_Display_Object *) */, 1295 Colormap id 1296) 1297{ 1298 X_Colormap_Object *E = FindColormap(dsHandle,id); 1299 1300 if (E) 1301 { 1302 return SAVE(E); 1303 } 1304 else 1305 { 1306 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Colormap_Object), F_MUTABLE_BIT); 1307 Handle cmapHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT | F_BYTE_OBJ); 1308 1309 /* Must do all allocations before we do the first dereference */ 1310 X_Colormap_Object *object = (X_Colormap_Object *)DEREFHANDLE(objectHandle); 1311 Colormap *cmap = (Colormap *)DEREFHANDLE(cmapHandle); 1312 1313 *cmap = id; FINISHED(taskData, cmapHandle); 1314 1315 object->type = TAGGED(X_Colormap); 1316 object->cmap = cmap; 1317 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1318 1319 debugRefer(Colormap,id); 1320 1321 return AddXObject(FINISHED(taskData, objectHandle)); 1322 } 1323} 1324 1325 1326/******************************************************************************/ 1327/* */ 1328/* Visual */ 1329/* */ 1330/******************************************************************************/ 1331static Visual *GetVisual(TaskData *taskData, X_Object *P) 1332{ 1333 static Visual EMPTYVISUAL = { 0 }; 1334 1335 assert(UNTAGGED(P->type) == X_Visual); 1336 1337 /* val NoVisual = xcall (24,0) : Visual; */ 1338 /* special case for NoVisual */ 1339 if (*(((X_Visual_Object *)P)->visual) == None) return &EMPTYVISUAL; /* FISHY (?) */ 1340 1341 CheckExists(P,visual); 1342 1343 return *(((X_Visual_Object *)P)->visual); 1344} 1345 1346static Handle EmptyVisual 1347( 1348 TaskData *taskData, 1349 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1350 Visual *v 1351) 1352{ 1353 if (v != None) 1354 { 1355 X_Visual_Object *E = FindVisual(dsHandle,v->visualid); 1356 1357 if (E) return SAVE(E); 1358 } 1359 1360 /* else */ 1361 { 1362 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Visual_Object), F_MUTABLE_BIT); 1363 Handle visualHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1364 1365 /* Must do all allocations before we do the first dereference */ 1366 X_Visual_Object *object = (X_Visual_Object *)DEREFHANDLE(objectHandle); 1367 Visual **visual = (Visual **)DEREFHANDLE(visualHandle); 1368 1369 *visual = v; FINISHED(taskData, visualHandle); 1370 1371 object->type = TAGGED(X_Visual); 1372 object->visual = visual; 1373 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1374 1375 debugRefer(Visual,(v == None) ? None : v->visualid); 1376 1377 return AddXObject(FINISHED(taskData, objectHandle)); 1378 } 1379} 1380 1381/******************************************************************************/ 1382/* */ 1383/* GC */ 1384/* */ 1385/******************************************************************************/ 1386static X_GC_Object *GCObject(X_Object *P) 1387{ 1388 assert(UNTAGGED(P->type) == X_GC); 1389 1390 return (X_GC_Object *)P; 1391} 1392 1393static GC GetGC(TaskData *taskData, X_Object *P) 1394{ 1395 assert(UNTAGGED(P->type) == X_GC); 1396 1397 CheckExists(P,gc); 1398 1399 return *(((X_GC_Object *)P)->gc); 1400} 1401 1402 1403static Handle GetDefaultGC(TaskData *taskData, Handle dsHandle /* Handle to (X_Display_Object *) */) 1404{ 1405 GC defaultGC = 1406 DefaultGC(DEREFDISPLAYHANDLE(dsHandle)->display, 1407 DEREFDISPLAYHANDLE(dsHandle)->screen); 1408 1409 X_GC_Object *G = FindGC(dsHandle,defaultGC->gid); 1410 1411 if (G) 1412 { 1413 return SAVE(G); 1414 } 1415 else 1416 { 1417 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_GC_Object), F_MUTABLE_BIT); 1418 Handle GCHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1419 1420 /* Must do all allocations before we do the first dereference */ 1421 X_GC_Object *object = (X_GC_Object *)DEREFHANDLE(objectHandle); 1422 GC *gc = (GC *)DEREFHANDLE(GCHandle); 1423 1424 *gc = defaultGC; FINISHED(taskData, GCHandle); 1425 1426 debugRefer(GC,defaultGC->gid); 1427 1428 object->type = TAGGED(X_GC); 1429 object->gc = gc; 1430 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1431/* 1432 object->font_object = 0; 1433 object->tile = 0; 1434 object->stipple = 0; 1435 object->clipMask = 0; 1436*/ 1437 1438 return AddXObject(objectHandle); /* must stay MUTABLE */ 1439 } 1440} 1441 1442static void ChangeGC(TaskData *taskData, X_GC_Object *G, unsigned n, PolyWord P) 1443{ 1444 XGCValues v; 1445 1446 unsigned mask = 1 << n; 1447 1448 switch(mask) 1449 { 1450 case GCFunction: v.function = get_C_ushort(taskData, P); break; 1451 case GCPlaneMask: v.plane_mask = get_C_ulong (taskData, P); break; 1452 case GCForeground: v.foreground = get_C_ulong (taskData, P); break; 1453 case GCBackground: v.background = get_C_ulong (taskData, P); break; 1454 case GCLineWidth: v.line_width = get_C_short (taskData, P); break; 1455 case GCLineStyle: v.line_style = get_C_ushort(taskData, P); break; 1456 case GCCapStyle: v.cap_style = get_C_ushort(taskData, P); break; 1457 case GCJoinStyle: v.join_style = get_C_ushort(taskData, P); break; 1458 case GCFillStyle: v.fill_style = get_C_ushort(taskData, P); break; 1459 case GCFillRule: v.fill_rule = get_C_ushort(taskData, P); break; 1460 case GCTileStipXOrigin: v.ts_x_origin = get_C_short (taskData, P); break; 1461 case GCTileStipYOrigin: v.ts_y_origin = get_C_short (taskData, P); break; 1462 case GCSubwindowMode: v.subwindow_mode = get_C_ushort(taskData, P); break; 1463 case GCGraphicsExposures: v.graphics_exposures = get_C_ushort(taskData, P); break; 1464 case GCClipXOrigin: v.clip_x_origin = get_C_short (taskData, P); break; 1465 case GCClipYOrigin: v.clip_y_origin = get_C_short (taskData, P); break; 1466 case GCDashOffset: v.dash_offset = get_C_ushort(taskData, P); break; 1467 case GCDashList: v.dashes = get_C_uchar (taskData, P); break; 1468 case GCArcMode: v.arc_mode = get_C_ushort(taskData, P); break; 1469 1470 case GCFont: v.font = GetFont(taskData, (X_Object *)P.AsObjPtr()); 1471 G->font_object = FontObject((X_Object *)P.AsObjPtr()); 1472 break; 1473 1474 case GCTile: v.tile = GetPixmap(taskData, (X_Object *)P.AsObjPtr()); 1475 G->tile = PixmapObject((X_Object *)P.AsObjPtr()); 1476 break; 1477 1478 case GCStipple: v.stipple = GetPixmap(taskData, (X_Object *)P.AsObjPtr()); 1479 G->stipple = PixmapObject((X_Object *)P.AsObjPtr()); 1480 break; 1481 1482 case GCClipMask: v.clip_mask = GetPixmap(taskData, (X_Object *)P.AsObjPtr()); 1483 G->clipMask = PixmapObject((X_Object *)P.AsObjPtr()); 1484 break; 1485 1486 default: Crash ("Bad gc mask %u",mask); 1487 } 1488 1489 XChangeGC(GetDisplay(taskData, (X_Object *)G),GetGC(taskData, (X_Object *)G),mask,&v); 1490} 1491 1492static Handle CreateGC 1493( 1494 TaskData *taskData, 1495 Handle dsHandle /* Handle to (X_Display_Object *) */, 1496 Drawable w 1497) 1498{ 1499 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_GC_Object), F_MUTABLE_BIT); 1500 Handle GCHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1501 1502 /* Must do all allocations before we do the first dereference */ 1503 X_GC_Object *object = (X_GC_Object *)DEREFHANDLE(objectHandle); 1504 GC *gc = (GC *)DEREFHANDLE(GCHandle); 1505 1506 *gc = XCreateGC(DEREFDISPLAYHANDLE(dsHandle)->display,w,0,0); 1507 FINISHED(taskData, GCHandle); 1508 1509 debugCreate(GC,(*gc)->gid); 1510 1511 object->type = TAGGED(X_GC); 1512 object->gc = gc; 1513 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1514/* 1515 object->font_object = 0; 1516 object->tile = 0; 1517 object->stipple = 0; 1518 object->clipMask = 0; 1519*/ 1520 return AddXObject(objectHandle); /* must remain MUTABLE */ 1521} 1522 1523 1524/******************************************************************************/ 1525/* */ 1526/* Window */ 1527/* */ 1528/******************************************************************************/ 1529static X_Window_Object *WindowObject(X_Object *P) 1530 1531{ 1532 assert(UNTAGGED(P->type) == X_Window); 1533 1534 return (X_Window_Object *)P; 1535} 1536 1537static Window GetWindow(TaskData *taskData, X_Object *P) 1538{ 1539 if (UNTAGGED(P->type) == X_Pixmap) 1540 { 1541 if (*((X_Pixmap_Object*)P)->pixmap == None) return None; 1542 1543 RaiseXWindows(taskData, "Not a window"); 1544 } 1545 1546 assert(UNTAGGED(P->type) == X_Window); 1547 1548 CheckExists(P,window); 1549 1550 return *(((X_Window_Object*)P)->drawable); 1551} 1552 1553static Handle EmptyWindow 1554( 1555 TaskData *taskData, 1556 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1557 Window w 1558) 1559{ 1560 X_Window_Object *W = FindWindow(dsHandle,w); 1561 1562 if (W) 1563 { 1564 return SAVE(W); 1565 } 1566 else 1567 { 1568 1569 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Window_Object), F_MUTABLE_BIT); 1570 Handle eventMaskHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1571 Handle drawableHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1572 1573 /* Must do all allocations before we do the first dereference */ 1574 X_Window_Object *object = DEREFWINDOWHANDLE(objectHandle); 1575 Drawable *drawable = (Drawable *)DEREFHANDLE(drawableHandle); 1576 PolyObject *eventMask = DEREFHANDLE(eventMaskHandle); 1577 1578 *drawable = w; FINISHED(taskData, drawableHandle); 1579 1580#ifdef nodef 1581 /* DCJM: This gets in the way of trying to handle ButtonPress events - 1582 get rid of it. */ 1583 /* so that Motif windows get ButtonClick XEvent structures */ 1584 eventMask->Set(0, PolyWord::FromUnsigned(ButtonClickMask)); /* eventMask must remain MUTABLE */ 1585#else 1586 eventMask->Set(0, PolyWord::FromUnsigned(0)); 1587#endif 1588 1589 object->type = TAGGED(X_Window); 1590 object->drawable = drawable; 1591 object->handler = TAGGED(0); 1592 object->state = TAGGED(0); 1593 object->eventMask = eventMask; 1594/* 1595 object->colormap_object = 0; 1596 object->cursor_object = 0; 1597 object->backgroundPixmap = 0; 1598 object->borderPixmap = 0; 1599 object->parent = 0; 1600*/ 1601 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1602 1603 debugRefer(Window,w); 1604 1605 return AddXObject(objectHandle); /* must remain MUTABLE */ 1606 } 1607} 1608 1609 1610/******************************************************************************/ 1611/* */ 1612/* Pixmap */ 1613/* */ 1614/******************************************************************************/ 1615 1616static X_Pixmap_Object *PixmapObject(X_Object *P) 1617{ 1618 assert(UNTAGGED(P->type) == X_Pixmap); 1619 1620 return (X_Pixmap_Object *)P; 1621} 1622 1623static Pixmap GetPixmap(TaskData *taskData, X_Object *P) 1624{ 1625 if (UNTAGGED(P->type) == X_Window) 1626 { 1627 1628 if (! ResourceExists(P)) 1629 { 1630 debug1("Non-existent window %lx\n",(long)P); 1631 } 1632 1633 if (*(((X_Window_Object*)P)->drawable) == None) return None; 1634 1635 RaiseXWindows(taskData, "Not a pixmap"); 1636 } 1637 1638 assert(UNTAGGED(P->type) == X_Pixmap); 1639 1640 /* val NoDrawable = xcall (20,0) : Drawable; */ 1641 /* val ParentRelative = xcall (20,1) : Drawable; */ 1642 1643 /* special case for NoDrawable */ 1644 if (*((X_Pixmap_Object*)P)->pixmap == 0) return None; 1645 1646 /* special case for ParentRelative */ 1647 if (*((X_Pixmap_Object*)P)->pixmap == 1) return None; 1648 1649 CheckExists(P,pixmap); 1650 1651 return *(((X_Pixmap_Object*)P)->pixmap); 1652} 1653 1654static Handle EmptyPixmap 1655( 1656 TaskData *taskData, 1657 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1658 Pixmap id 1659) 1660{ 1661 X_Pixmap_Object *E = FindPixmap(dsHandle,id); 1662 1663 if (E) 1664 { 1665 return SAVE(E); 1666 } 1667 else 1668 { 1669 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Pixmap_Object), F_MUTABLE_BIT); 1670 Handle pixmapHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1671 1672 /* Must do all allocations before we do the first dereference */ 1673 X_Pixmap_Object *object = (X_Pixmap_Object *)DEREFHANDLE(objectHandle); 1674 Pixmap *pixmap = (Pixmap *)DEREFHANDLE(pixmapHandle); 1675 1676 *pixmap = id; FINISHED(taskData, pixmapHandle); 1677 1678 object->type = TAGGED(X_Pixmap); 1679 object->pixmap = pixmap; 1680 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1681 1682 debugCreate(Pixmap,id); 1683 1684 return AddXObject(FINISHED(taskData, objectHandle)); 1685 } 1686} 1687 1688 1689/******************************************************************************/ 1690/* */ 1691/* Drawable */ 1692/* */ 1693/******************************************************************************/ 1694 1695static Drawable GetDrawable(TaskData *taskData, X_Object *P) 1696{ 1697 CheckExists(P,drawable); 1698 1699 switch(UNTAGGED(P->type)) 1700 { 1701 case X_Window: return *(((X_Window_Object*)P)->drawable); 1702 case X_Pixmap: return *(((X_Pixmap_Object*)P)->pixmap); 1703 default: Crash ("Bad X_Object type (%d) in GetDrawable",UNTAGGED(P->type)); 1704 } 1705 1706 /*NOTREACHED*/ 1707} 1708 1709/******************************************************************************/ 1710/* */ 1711/* DS / Display */ 1712/* */ 1713/******************************************************************************/ 1714static Handle GetDS(TaskData *taskData, X_Object *P) 1715{ 1716 X_Display_Object *ds; 1717 1718 CheckExists(P,resource); 1719 1720 switch(UNTAGGED(P->type)) 1721 { 1722 case X_GC: ds = ((X_GC_Object*)P)->ds; break; 1723 case X_Font: ds = ((X_Font_Object*)P)->ds; break; 1724 case X_Cursor: ds = ((X_Cursor_Object*)P)->ds; break; 1725 case X_Window: ds = ((X_Window_Object*)P)->ds; break; 1726 case X_Pixmap: ds = ((X_Pixmap_Object*)P)->ds; break; 1727 case X_Colormap: ds = ((X_Colormap_Object*)P)->ds; break; 1728 case X_Visual: ds = ((X_Visual_Object*)P)->ds; break; 1729 case X_Widget: ds = ((X_Widget_Object*)P)->ds; break; 1730 case X_Display: ds = (X_Display_Object*)P; break; /* i.e. P cast to the right type */ 1731 1732 default: Crash ("Bad X_Object type (%d) in GetDS",UNTAGGED(P->type)); 1733 } 1734 1735 assert((PolyWord)ds != TAGGED(0)); 1736 1737 return SAVE(ds); 1738} 1739 1740 1741static Display *GetDisplay(TaskData *taskData, X_Object *P) 1742{ 1743 CheckExists(P,resource); 1744 1745 switch(UNTAGGED(P->type)) 1746 { 1747 case X_GC: return ((X_GC_Object*)P)->ds->display; 1748 case X_Font: return ((X_Font_Object*)P)->ds->display; 1749 case X_Cursor: return ((X_Cursor_Object*)P)->ds->display; 1750 case X_Window: return ((X_Window_Object*)P)->ds->display; 1751 case X_Pixmap: return ((X_Pixmap_Object*)P)->ds->display; 1752 case X_Colormap: return ((X_Colormap_Object*)P)->ds->display; 1753 case X_Visual: return ((X_Visual_Object*)P)->ds->display; 1754 case X_Widget: return ((X_Widget_Object*)P)->ds->display; 1755 case X_Display: return ((X_Display_Object*)P)->display; 1756 1757 default: Crash ("Bad X_Object type (%d) in GetDisplay",UNTAGGED(P->type)); 1758 } 1759 1760 /*NOTREACHED*/ 1761} 1762 1763 1764/******************************************************************************/ 1765/* */ 1766/* FS / Font */ 1767/* */ 1768/******************************************************************************/ 1769static Font GetFont(TaskData *taskData, X_Object *P) 1770{ 1771 assert(UNTAGGED(P->type) == X_Font); 1772 1773 /* val NoFont = xcall (22,0) : Font; */ 1774 /* special case for NoFont - valid(?) */ 1775 if (*(((X_Font_Object *)P)->font) == None) return None; 1776 1777 CheckExists(P,font); 1778 1779 return *(((X_Font_Object *)P)->font); 1780} 1781 1782 1783static Handle EmptyFont 1784( 1785 TaskData *taskData, 1786 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1787 Font id, 1788 XFontStruct *fs 1789) 1790{ 1791 X_Font_Object *E = FindFont(dsHandle,id); 1792 1793 if (E && (fs == NULL || *(E->fs) == fs)) 1794 { 1795 return SAVE(E); 1796 } 1797 else 1798 { 1799 1800 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Font_Object), F_MUTABLE_BIT); 1801 Handle fontHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1802 Handle FSHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1803 1804 /* Must do all allocations before we do the first dereference */ 1805 X_Font_Object *object = (X_Font_Object *)DEREFHANDLE(objectHandle); 1806 Font *font = (Font *)DEREFHANDLE(fontHandle); 1807 XFontStruct **xfstr = (XFontStruct **)DEREFHANDLE(FSHandle); 1808 1809 *font = id; FINISHED(taskData, fontHandle); 1810 *xfstr = fs; FINISHED(taskData, FSHandle); 1811 1812 object->type = TAGGED(X_Font); 1813 object->font = font; 1814 object->fs = xfstr; 1815 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1816 1817 debugCreate(Font,id); 1818 1819 return AddXObject(FINISHED(taskData, objectHandle)); 1820 } 1821} 1822 1823 1824 1825/******************************************************************************/ 1826/* */ 1827/* Cursor */ 1828/* */ 1829/******************************************************************************/ 1830static X_Cursor_Object *CursorObject(X_Object *P) 1831{ 1832 assert(UNTAGGED(P->type) == X_Cursor); 1833 1834 return (X_Cursor_Object *)P; 1835} 1836 1837static Cursor GetCursor(TaskData *taskData, X_Object *P) 1838{ 1839 assert(UNTAGGED(P->type) == X_Cursor); 1840 1841 /* val NoCursor = xcall (21,0) : Cursor; */ 1842 /* special case for NoCursor */ 1843 if (*(((X_Cursor_Object *)P)->cursor) == None) return None; 1844 1845 CheckExists(P,cursor); 1846 1847 return *(((X_Cursor_Object *)P)->cursor); 1848} 1849 1850 1851static Handle EmptyCursor 1852( 1853 TaskData *taskData, 1854 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1855 Cursor id 1856) 1857{ 1858 X_Cursor_Object *E = FindCursor(dsHandle,id); 1859 1860 if (E) 1861 { 1862 return SAVE(E); 1863 } 1864 else 1865 { 1866 1867 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Cursor_Object), F_MUTABLE_BIT); 1868 Handle cursorHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 1869 1870 /* Must do all allocations before we do the first dereference */ 1871 X_Cursor_Object *object = (X_Cursor_Object *)DEREFHANDLE(objectHandle); 1872 Cursor *cursor = (Cursor *)DEREFHANDLE(cursorHandle); 1873 1874 *cursor = id; FINISHED(taskData, cursorHandle); 1875 1876 object->type = TAGGED(X_Cursor); 1877 object->cursor = cursor; 1878 object->ds = DEREFDISPLAYHANDLE(dsHandle); 1879 1880 debugRefer(Cursor,id); 1881 1882 return AddXObject(FINISHED(taskData, objectHandle)); 1883 } 1884} 1885 1886static Handle CreateFontCursor 1887( 1888 TaskData *taskData, 1889 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1890 unsigned shape 1891) 1892{ 1893 return EmptyCursor(taskData, dsHandle,XCreateFontCursor(DEREFDISPLAYHANDLE(dsHandle)->display,shape)); 1894} 1895 1896static Handle CreateGlyphCursor 1897( 1898 TaskData *taskData, 1899 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1900 Font sf, 1901 Font mf, 1902 unsigned sc, 1903 unsigned mc, 1904 XColor *foreground, 1905 XColor *background 1906) 1907{ 1908 return EmptyCursor(taskData, dsHandle,XCreateGlyphCursor(DEREFDISPLAYHANDLE(dsHandle)->display,sf,mf,sc,mc,foreground,background)); 1909} 1910 1911static Handle CreatePixmapCursor 1912( 1913 TaskData *taskData, 1914 Handle dsHandle, /* Handle to (X_Display_Object *) */ 1915 Pixmap source, 1916 Pixmap mask, 1917 XColor *foreground, 1918 XColor *background, 1919 unsigned x, 1920 unsigned y 1921) 1922{ 1923 return EmptyCursor(taskData, dsHandle,XCreatePixmapCursor(DEREFDISPLAYHANDLE(dsHandle)->display,source,mask,foreground,background,x,y)); 1924} 1925 1926/******************************************************************************/ 1927/* */ 1928/* Widget */ 1929/* */ 1930/******************************************************************************/ 1931static Widget GetNWidget(TaskData *taskData, X_Object *P) 1932{ 1933 assert(UNTAGGED(P->type) == X_Widget); 1934 1935 if (*(((X_Widget_Object *)P)->widget) == NULL) return NULL; 1936 1937 CheckExists(P,widget); 1938 1939 return *(((X_Widget_Object *)P)->widget); 1940} 1941 1942static Widget GetWidget(TaskData *taskData, X_Object *P) 1943{ 1944 assert(UNTAGGED(P->type) == X_Widget); 1945 1946 if (*(((X_Widget_Object *)P)->widget) == NULL) 1947 { 1948 RaiseXWindows(taskData, "Not a real widget"); 1949 } 1950 1951 CheckExists(P,widget); 1952 1953 return *(((X_Widget_Object *)P)->widget); 1954} 1955 1956/* added 6/11/94 SPF */ 1957static Widget GetRealizedWidget(TaskData *taskData, char *where, X_Object *P) 1958{ 1959 Widget w; 1960 1961 assert(UNTAGGED(P->type) == X_Widget); 1962 1963 w = *(((X_Widget_Object *)P)->widget); 1964 1965 if (w == NULL) 1966 { 1967 RaiseXWindows2(where,": not a real widget"); 1968 } 1969 1970 CheckExists(P,widget); 1971 1972 if (XtIsRealized(w) == False) 1973 { 1974 RaiseXWindows2(where,": widget is not realized"); 1975 } 1976 1977 return w; 1978} 1979 1980/* P is a pointer to an X_Widget_Object */ 1981static X_Widget_Object *WidgetObjectToken(X_Object *P) 1982{ 1983 assert(UNTAGGED(P->type) == X_Widget); 1984 return (X_Widget_Object *)P; 1985} 1986 1987/* P is a pointer to an X_Widget_Object, which is bound to a C widget */ 1988static X_Widget_Object *WidgetObject(TaskData *taskData, X_Object *P) 1989{ 1990 assert(UNTAGGED(P->type) == X_Widget); 1991 1992 CheckExists(P,widget); 1993 1994 return (X_Widget_Object *)P; 1995} 1996 1997 1998static Handle EmptyWidget 1999( 2000 TaskData *taskData, 2001 Handle dsHandle, /* Handle to (X_Display_Object *) */ 2002 Widget id 2003) 2004{ 2005 X_Widget_Object *E = FindWidget(id); 2006 2007 if (E) 2008 { 2009 return SAVE(E); 2010 } 2011 else 2012 { 2013 2014 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Widget_Object), F_MUTABLE_BIT); 2015 Handle widgetHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 2016 2017 /* Must do all allocations before we do the first dereference */ 2018 X_Widget_Object *object = (X_Widget_Object *)DEREFHANDLE(objectHandle); 2019 Widget *widget = (Widget *)DEREFHANDLE(widgetHandle); 2020 2021 *widget = id; FINISHED(taskData, widgetHandle); 2022 2023 object->type = TAGGED(X_Widget); 2024 object->widget = widget; 2025 object->callbackList = ListNull; 2026 object->state = TAGGED(0); 2027 object->ds = DEREFDISPLAYHANDLE(dsHandle); 2028 2029 debugRefer(Widget,id); 2030 2031 return AddXObject(objectHandle); /* Must stay MUTABLE */ 2032 } 2033} 2034 2035static Handle NewWidget 2036( 2037 TaskData *taskData, 2038 Handle dsHandle, /* Handle to (X_Display_Object *) */ 2039 Widget id 2040) 2041{ 2042 X_Widget_Object *E = FindWidget(id); 2043 2044 if (E) DestroyXObject((X_Object *)E); 2045 2046 return EmptyWidget(taskData, dsHandle,id); 2047} 2048 2049 2050/******************************************************************************/ 2051/* */ 2052/* Text Widgets */ 2053/* */ 2054/******************************************************************************/ 2055static Widget GetTextWidget(TaskData *taskData, char *funcname, X_Object *P) 2056{ 2057 Widget w = GetWidget(taskData, P); 2058 2059 if (XmIsText(w)) return w; 2060 2061 /* Text operations are also legal on TextField widgets */ 2062 if (XmIsTextField(w)) return w; 2063 2064 RaiseXWindows2(funcname,": not a Text or TextField widget"); 2065 /*NOTREACHED*/ 2066} 2067 2068 2069/******************************************************************************/ 2070/* */ 2071/* TextField Widgets */ 2072/* */ 2073/******************************************************************************/ 2074static Widget GetTextFieldWidget(TaskData *taskData, char *funcname, X_Object *P) 2075{ 2076 Widget w = GetWidget(taskData, P); 2077 2078 if (XmIsTextField(w)) return w; 2079 2080 RaiseXWindows2(funcname,": not a TextField widget"); 2081 /*NOTREACHED*/ 2082} 2083 2084/******************************************************************************/ 2085/* */ 2086/* List Widgets */ 2087/* */ 2088/******************************************************************************/ 2089static Widget GetListWidget(TaskData *taskData, char *funcname, X_Object *P) 2090{ 2091 Widget w = GetWidget(taskData, P); 2092 2093 if (XmIsList(w)) return w; 2094 2095 RaiseXWindows2(funcname,": not a List widget"); 2096 /*NOTREACHED*/ 2097} 2098 2099 2100/******************************************************************************/ 2101/* */ 2102/* Window */ 2103/* */ 2104/******************************************************************************/ 2105static void RemoveWindowEvents(Display *d, Window w) 2106{ 2107 XEvent event; 2108 2109 XSync(d,False); 2110 2111 while(XCheckWindowEvent(d,w,~0,&event)) 2112 { 2113 /* do nothing */ 2114 } 2115} 2116 2117 2118static Handle AddWindow 2119( 2120 TaskData *taskData, 2121 Window W, 2122 Handle handlerHandle, /* Handle to (PolyWord *) (?) */ 2123 Handle stateHandle, /* Handle to (PolyWord *) (?) */ 2124 Handle parentHandle /* Handle to (X_Window_Object *) */ 2125) 2126{ 2127 XWMHints hints; 2128 Atom deleteWindow; /* was int SPF 6/1/94 */ 2129 Display *d = GetDisplay(taskData, DEREFXOBJECTHANDLE(parentHandle)); 2130 2131 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Window_Object), F_MUTABLE_BIT); 2132 Handle eventMaskHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 2133 Handle drawableHandle = alloc_and_save(taskData, 1, F_MUTABLE_BIT|F_BYTE_OBJ); 2134 2135 /* Must do all allocations before we do the first dereference */ 2136 X_Window_Object *object = DEREFWINDOWHANDLE(objectHandle); 2137 Drawable *drawable = (Drawable *)DEREFHANDLE(drawableHandle); 2138 PolyObject *eventMask = DEREFHANDLE(eventMaskHandle); 2139 2140 eventMask->Set(0, PolyWord::FromUnsigned(0)); /* eventMask must remain MUTABLE */ 2141 *drawable = W; FINISHED(taskData, drawableHandle); 2142 2143 hints.flags = InputHint; 2144 hints.input = True; 2145 2146 XSetWMHints(d,W,&hints); 2147 2148 deleteWindow = WM_DELETE_WINDOW(d); 2149 2150 if (deleteWindow != None) XSetWMProtocols(d,W,&deleteWindow,1); 2151 2152 debugCreate(Window,W); 2153 2154 object->type = TAGGED(X_Window); 2155 object->drawable = drawable; 2156 object->eventMask = eventMask; 2157 object->handler = DEREFHANDLE(handlerHandle); 2158 object->state = DEREFHANDLE(stateHandle); 2159 object->parent = DEREFWINDOWHANDLE(parentHandle); 2160 object->ds = DEREFWINDOWHANDLE(parentHandle)->ds; /* Tidy up (?) */ 2161/* 2162 object->colormap_object = 0; 2163 object->cursor_object = 0; 2164 object->backgroundPixmap = 0; 2165 object->borderPixmap = 0; 2166*/ 2167 2168 if (ISNIL(DEREFHANDLE(handlerHandle))) Crash ("No handler set"); 2169 2170 return AddXObject(objectHandle); /* object must remain MUTABLE */ 2171} 2172 2173static void DestroyWindow(X_Object *W /* Should be a Window Object! */) 2174{ 2175 TaskData *taskData = processes->GetTaskDataForThread(); 2176 Window w = GetWindow(taskData, W); 2177 Display *d = GetDisplay(taskData, W); 2178 2179 debugReclaim(Window,w); 2180 2181 XUnmapWindow(d,w); 2182 2183 DestroySubwindows(W); 2184 2185 XDestroyWindow(d,w); 2186 2187 RemoveWindowEvents(d,w); 2188} 2189 2190static Handle CreateSimpleWindow 2191( 2192 TaskData *taskData, 2193 Handle parent, /* Handle to (X_Window_Object *) */ 2194 int x, 2195 int y, 2196 unsigned w, 2197 unsigned h, 2198 unsigned borderWidth, 2199 unsigned border, 2200 unsigned background, 2201 Handle handler, /* Handle to (PolyWord *) (?) */ 2202 Handle state /* Handle to (PolyWord *) (?) */ 2203) 2204{ 2205 Window W = XCreateSimpleWindow(GetDisplay(taskData, DEREFXOBJECTHANDLE(parent)), 2206 GetWindow(taskData, DEREFXOBJECTHANDLE(parent)), 2207 x,y,w,h, 2208 borderWidth,border,background); 2209 2210 if (W == 0) RaiseXWindows(taskData, "XCreateSimpleWindow failed"); 2211 2212 return AddWindow(taskData,W,handler,state,parent); 2213} 2214 2215static Handle CreateWindow 2216( 2217 TaskData *taskData, 2218 Handle parent, /* Handle to (X_Window_Object *) */ 2219 int x, 2220 int y, 2221 unsigned w, 2222 unsigned h, 2223 unsigned borderWidth, 2224 unsigned depth, 2225 unsigned clas, 2226 Visual *visual, 2227 Handle handler, /* Handle to (PolyWord *) (?) */ 2228 Handle state /* Handle to (PolyWord *) (?) */ 2229) 2230{ 2231 Window W; 2232 2233 W = XCreateWindow(GetDisplay(taskData, DEREFXOBJECTHANDLE(parent)), 2234 GetWindow(taskData, DEREFXOBJECTHANDLE(parent)), 2235 x,y,w,h, 2236 borderWidth,depth,clas,visual,0,0); 2237 2238 if (W == 0) RaiseXWindows(taskData, "XCreateWindow failed"); 2239 2240 return AddWindow(taskData,W,handler,state,parent); 2241} 2242 2243static void DestroySubwindows(X_Object *W /* should be a Window object! */) 2244{ 2245 TaskData *taskData = processes->GetTaskDataForThread(); 2246 Window root,parent,*children; 2247 unsigned n; 2248 int s; 2249 2250 Window w = GetWindow(taskData, W); 2251 Display *d = GetDisplay(taskData, W); 2252 2253 s = XQueryTree(d,w,&root,&parent,&children,&n); 2254 2255 if (s == 0) 2256 { 2257 RaiseXWindows(taskData, "XDestroySubwindows failed"); 2258 return; 2259 } 2260 2261 XUnmapSubwindows(d,w); 2262 2263 if (n) 2264 { 2265 Handle dsHandle = GetDS(taskData, W); 2266 2267 while(n--) 2268 { 2269 X_Window_Object *child = FindWindow(dsHandle,children[n]); 2270 2271 if (child) DestroyXObject((X_Object *)child); 2272 } 2273 2274 XFree((char *)children); 2275 } 2276 2277 XDestroySubwindows(d,w); 2278} 2279 2280 2281/******************************************************************************/ 2282/* */ 2283/* Translations / Accelerators */ 2284/* */ 2285/******************************************************************************/ 2286static Handle EmptyTrans(TaskData *taskData, XtTranslations table) 2287{ 2288 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Trans_Object), F_MUTABLE_BIT|F_BYTE_OBJ); 2289 2290 /* Must do all allocations before we do the first dereference */ 2291 X_Trans_Object *object = (X_Trans_Object *)DEREFHANDLE(objectHandle); 2292 2293 /* OK to store C values because this is a byte object */ 2294 object->type = TAGGED(X_Trans); 2295 object->table = table; 2296 2297 debugRefer(Trans,table); 2298 2299 return AddXObject(FINISHED(taskData, objectHandle)); 2300} 2301 2302static XtTranslations GetTrans(TaskData *taskData, X_Object *P) 2303{ 2304 assert(UNTAGGED(P->type) == X_Trans); 2305 2306 CheckExists(P,trans); 2307 2308 return ((X_Trans_Object *)P)->table; 2309} 2310 2311static Handle EmptyAcc(TaskData *taskData, XtTranslations acc) 2312{ 2313 2314 Handle objectHandle = alloc_and_save(taskData, SIZEOF(X_Acc_Object), F_MUTABLE_BIT|F_BYTE_OBJ); 2315 2316 /* Must do all allocations before we do the first dereference */ 2317 X_Acc_Object *object = (X_Acc_Object *)DEREFHANDLE(objectHandle); 2318 2319 /* OK to store C values because this is a byte object */ 2320 object->type = TAGGED(X_Acc); 2321 object->acc = acc; 2322 2323 debugRefer(Acc,acc); 2324 2325 return AddXObject(FINISHED(taskData, objectHandle)); 2326} 2327 2328static XtAccelerators GetAcc(TaskData *taskData, X_Object *P) 2329{ 2330 assert(UNTAGGED(P->type) == X_Acc); 2331 2332 CheckExists(P,acc); 2333 2334 return ((X_Acc_Object *)P)->acc; 2335} 2336 2337/******************************************************************************/ 2338/* */ 2339/* Utility functions */ 2340/* */ 2341/******************************************************************************/ 2342 2343static XtGrabKind GetXtGrabKind(TaskData *taskData, PolyWord P) 2344{ 2345 int i = get_C_long(taskData, P); 2346 2347 /* This encoding must be the same as that used in Motif/ml_bind.ML */ 2348 switch (i) 2349 { 2350 case 0: return XtGrabNone; 2351 case 1: return XtGrabNonexclusive; 2352 case 2: return XtGrabExclusive; 2353 2354 default: Crash ("Bad XtGrabKind index (%d) in GetXtGrabKind",i); 2355 } 2356 2357 return XtGrabNone; /* to keep lint/gcc happy */ 2358} 2359 2360/******************************************************************************/ 2361/* */ 2362/* MLXStandardColormap - implements ML XStandardColormap datatype */ 2363/* */ 2364/******************************************************************************/ 2365 2366typedef struct 2367{ 2368 X_Colormap_Object *Colormap; 2369 PolyWord redMax; /* ML int */ 2370 PolyWord redMult; /* ML int */ 2371 PolyWord greenMax; /* ML int */ 2372 PolyWord greenMult; /* ML int */ 2373 PolyWord blueMax; /* ML int */ 2374 PolyWord blueMult; /* ML int */ 2375 PolyWord basePixel; /* ML int */ 2376 X_Visual_Object *visual; 2377} MLXStandardColormap; 2378 2379 2380static void GetStandardColormap(TaskData *taskData, PolyWord p, void *v, unsigned) 2381{ 2382 MLXStandardColormap *P = (MLXStandardColormap *)p.AsObjPtr(); 2383 XStandardColormap *s = (XStandardColormap *)v; 2384 s->colormap = GetColormap(taskData, (X_Object *)P->Colormap); 2385 2386 s->red_max = get_C_ulong(taskData, P->redMax); 2387 s->red_mult = get_C_ulong(taskData, P->redMult); 2388 s->green_max = get_C_ulong(taskData, P->greenMax); 2389 s->green_mult = get_C_ulong(taskData, P->greenMult); 2390 s->blue_max = get_C_ulong(taskData, P->blueMax); 2391 s->blue_mult = get_C_ulong(taskData, P->blueMult); 2392 s->base_pixel = get_C_ulong(taskData, P->basePixel); 2393 2394 s->visualid = GetVisual(taskData, (X_Object *)P->visual)->visualid; /* UNSAFE(?) */ 2395 s->killid = None; 2396} 2397 2398static Handle CreateStandardColormap 2399( 2400 TaskData *taskData, 2401 void *v, 2402 Handle dsHandle /* Handle to (X_Display_Object *) */ 2403) 2404{ 2405 XStandardColormap *s = (XStandardColormap *)v; 2406 XVisualInfo T; 2407 XVisualInfo *info; 2408 int count; 2409 2410 Handle tupleHandle = alloc_and_save(taskData, SIZEOF(MLXStandardColormap), F_MUTABLE_BIT); 2411 2412 T.visualid = s->visualid; 2413 T.visual = None; 2414 2415 info = XGetVisualInfo(DEREFDISPLAYHANDLE(dsHandle)->display,VisualIDMask,&T,&count); 2416 2417 if (info) 2418 { 2419 T.visual = info->visual; 2420 2421 XFree((char *)info); 2422 } 2423 2424/* Still allocating, so must use explicit DEREF for each element */ 2425#define tuple /* hack */((MLXStandardColormap *)DEREFHANDLE(tupleHandle)) 2426 tuple->Colormap = (X_Colormap_Object *)DEREFHANDLE(EmptyColormap(taskData, dsHandle,s->colormap)); 2427 tuple->redMax = DEREFWORD(Make_arbitrary_precision(taskData, s->red_max)); 2428 tuple->redMult = DEREFWORD(Make_arbitrary_precision(taskData, s->red_mult)); 2429 tuple->greenMax = DEREFWORD(Make_arbitrary_precision(taskData, s->green_max)); 2430 tuple->greenMult = DEREFWORD(Make_arbitrary_precision(taskData, s->green_mult)); 2431 tuple->blueMax = DEREFWORD(Make_arbitrary_precision(taskData, s->blue_max)); 2432 tuple->blueMult = DEREFWORD(Make_arbitrary_precision(taskData, s->blue_mult)); 2433 tuple->basePixel = DEREFWORD(Make_arbitrary_precision(taskData, s->base_pixel)); 2434 tuple->visual = (X_Visual_Object *)DEREFHANDLE(EmptyVisual(taskData, dsHandle,T.visual)); 2435#undef tuple 2436 2437 return FINISHED(taskData, tupleHandle); 2438} 2439 2440 2441/******************************************************************************/ 2442/* */ 2443/* Polymorphic pairs */ 2444/* */ 2445/******************************************************************************/ 2446 2447class MLPair: public PolyObject 2448{ 2449public: 2450 PolyWord x0; /* first value */ 2451 PolyWord x1; /* second value */ 2452}; 2453 2454 2455/* Polymorphic pair creation */ 2456static Handle CreatePair(TaskData *taskData, Handle p1, Handle p2) 2457{ 2458 Handle pairHandle = alloc_and_save(taskData, SIZEOF(MLPair), F_MUTABLE_BIT); 2459 2460/* Still allocating, so must use explicit DEREF for each element */ 2461#define pair ((MLPair *)DEREFHANDLE(pairHandle)) 2462 pair->x0 = DEREFWORD(p1); 2463 pair->x1 = DEREFWORD(p2); 2464#undef pair 2465 2466 return FINISHED(taskData, pairHandle); 2467} 2468 2469 2470/******************************************************************************/ 2471/* */ 2472/* Polymorphic triples */ 2473/* */ 2474/******************************************************************************/ 2475 2476class MLTriple: public PolyObject 2477{ 2478public: 2479 PolyWord x0; /* first value */ 2480 PolyWord x1; /* second value */ 2481 PolyWord x2; /* third value */ 2482}; 2483 2484inline PolyWord FST(PolyWord P) { return ((MLTriple*)P.AsObjPtr())->x0; } 2485inline PolyWord SND(PolyWord P) { return ((MLTriple*)P.AsObjPtr())->x1; } 2486inline PolyWord THIRD(PolyWord P) { return ((MLTriple*)P.AsObjPtr())->x2; } 2487 2488static Handle CreateTriple(TaskData *taskData, Handle p1, Handle p2, Handle p3) 2489{ 2490 Handle tripleHandle = alloc_and_save(taskData, SIZEOF(MLTriple), F_MUTABLE_BIT); 2491 2492/* Still allocating, so must use explicit DEREF for each element */ 2493#define triple ((MLTriple *)DEREFHANDLE(tripleHandle)) 2494 triple->x0 = DEREFWORD(p1); 2495 triple->x1 = DEREFWORD(p2); 2496 triple->x2 = DEREFWORD(p3); 2497#undef triple 2498 2499 return FINISHED(taskData, tripleHandle); 2500} 2501 2502 2503/******************************************************************************/ 2504/* */ 2505/* MLXImage - Implements ML XImage datatype */ 2506/* */ 2507/******************************************************************************/ 2508typedef struct 2509{ 2510 PolyWord data; /* ML (abstype containing) string */ 2511 PolyWord size; /* MLXRectangle * */ 2512 PolyWord depth; /* ML int */ 2513 PolyWord format; /* (short ML int) XYBitmap | XYPixmap | ZPixmap */ 2514 PolyWord xoffset; /* ML int */ 2515 PolyWord bitmapPad; /* ML int */ 2516 PolyWord byteOrder; /* (short ML int) LSBFirst | MSBFirst */ 2517 PolyWord bitmapUnit; /* ML int */ 2518 PolyWord bitsPerPixel; /* ML int */ 2519 PolyWord bytesPerLine; /* ML int */ 2520 PolyWord visualRedMask; /* ML int */ 2521 PolyWord bitmapBitOrder; /* (short ML int) LSBFirst | MSBFirst */ 2522 PolyWord visualBlueMask; /* ML int */ 2523 PolyWord visualGreenMask; /* ML int */ 2524} MLXImage; 2525 2526#define MLImageFormat(n) (n+1) 2527#define MLImageOrder(n) (n+1) 2528#define CImageFormat(n) (n-1) 2529#define CImageOrder(n) (n-1) 2530 2531static unsigned ImageBytes(XImage *image) 2532{ 2533 unsigned dsize = image->bytes_per_line * image->height; 2534 if (image->format == XYPixmap) dsize = dsize * image->depth; 2535 return dsize; 2536} 2537 2538static XImage *GetXImage(TaskData *taskData, Display *d, PolyWord p) 2539/* can only be called once per X opcode */ 2540{ 2541 MLXImage *I = (MLXImage *)p.AsObjPtr(); 2542 static XImage image = { 0 }; 2543 2544 PolyStringObject *data = GetString(I->data); 2545 unsigned width = GetRectW(taskData, I->size); 2546 unsigned height = GetRectH(taskData, I->size); 2547 unsigned depth = get_C_ulong(taskData, I->depth); 2548 unsigned format = get_C_ulong(taskData, I->format); 2549 int xoffset = get_C_short(taskData, I->xoffset); 2550 int bitmapPad = get_C_short(taskData, I->bitmapPad); 2551 int bytesPerLine = get_C_long (taskData, I->bytesPerLine); 2552 2553 unsigned byteOrder = get_C_ulong(taskData, I->byteOrder); 2554 unsigned bitmapUnit = get_C_ulong(taskData, I->bitmapUnit); 2555 unsigned bitsPerPixel = get_C_ulong(taskData, I->bitsPerPixel); 2556 unsigned bitmapBitOrder = get_C_ulong(taskData, I->bitmapBitOrder); 2557 2558 format = CImageFormat(format); 2559 byteOrder = CImageOrder(byteOrder); 2560 bitmapBitOrder = CImageOrder(bitmapBitOrder); 2561 2562 image.width = width; 2563 image.height = height; 2564 image.xoffset = xoffset; 2565 image.format = format; 2566 image.data = data->chars; 2567 image.byte_order = byteOrder; 2568 image.bitmap_unit = bitmapUnit; 2569 image.bitmap_bit_order = bitmapBitOrder; 2570 image.bitmap_pad = bitmapPad; 2571 image.depth = depth; 2572 image.bytes_per_line = bytesPerLine; 2573 image.bits_per_pixel = bitsPerPixel; 2574 image.red_mask = get_C_ulong(taskData, I->visualRedMask); 2575 image.green_mask = get_C_ulong(taskData, I->visualGreenMask); 2576 image.blue_mask = get_C_ulong(taskData, I->visualBlueMask); 2577 2578 if (ImageBytes(&image) != data->length) RaiseXWindows(taskData, "Bad image string length"); 2579 2580 return ℑ 2581} 2582 2583static Handle CreateImage(TaskData *taskData, XImage *image) 2584{ 2585 Handle XHandle = alloc_and_save(taskData, SIZEOF(MLXImage), F_MUTABLE_BIT); 2586 2587 int dsize = ImageBytes(image); 2588 2589/* Still allocating, so must use explicit DEREF for each element */ 2590#define X ((MLXImage *)DEREFHANDLE(XHandle)) 2591 X->data = C_string_to_Poly(taskData, image->data,dsize); 2592 X->size = DEREFWORD(CreateArea(image->width,image->height)); 2593 X->depth = DEREFWORD(Make_arbitrary_precision(taskData, image->depth)); 2594 X->format = DEREFWORD(Make_arbitrary_precision(taskData, MLImageFormat(image->format))); 2595 X->xoffset = DEREFWORD(Make_int(image->xoffset)); 2596 X->bitmapPad = DEREFWORD(Make_int(image->bitmap_pad)); 2597 X->byteOrder = DEREFWORD(Make_arbitrary_precision(taskData, MLImageOrder(image->byte_order))); 2598 X->bitmapUnit = DEREFWORD(Make_arbitrary_precision(taskData, image->bitmap_unit)); 2599 X->bitsPerPixel = DEREFWORD(Make_arbitrary_precision(taskData, image->bits_per_pixel)); 2600 X->bytesPerLine = DEREFWORD(Make_int(image->bytes_per_line)); 2601 X->visualRedMask = DEREFWORD(Make_arbitrary_precision(taskData, image->red_mask)); 2602 X->bitmapBitOrder = DEREFWORD(Make_arbitrary_precision(taskData, MLImageOrder(image->bitmap_bit_order))); 2603 X->visualBlueMask = DEREFWORD(Make_arbitrary_precision(taskData, image->blue_mask)); 2604 X->visualGreenMask = DEREFWORD(Make_arbitrary_precision(taskData, image->green_mask)); 2605#undef X 2606 2607 XDestroyImage(image); 2608 2609 return FINISHED(taskData, XHandle); 2610} 2611 2612static Handle GetImage 2613( 2614 TaskData *taskData, 2615 Display *d, 2616 Drawable drawable, 2617 int x, 2618 int y, 2619 unsigned w, 2620 unsigned h, 2621 unsigned /* long */ mask, 2622 int format 2623) 2624{ 2625 XImage *image = XGetImage(d,drawable,x,y,w,h,mask,CImageFormat(format)); 2626 2627 if (image == 0) RaiseXWindows(taskData, "XGetImage failed"); 2628 2629 return CreateImage(taskData, image); 2630} 2631 2632static Handle SubImage 2633( 2634 TaskData *taskData, 2635 XImage *image, 2636 int x, 2637 int y, 2638 unsigned w, 2639 unsigned h 2640) 2641{ 2642 XImage *subimage = XSubImage(image,x,y,w,h); 2643 2644 if (subimage == 0) RaiseXWindows(taskData, "XSubImage failed"); 2645 2646 return CreateImage(taskData, subimage); 2647} 2648 2649 2650/******************************************************************************/ 2651/* */ 2652/* XImage */ 2653/* */ 2654/******************************************************************************/ 2655static void GetSubImage 2656( 2657 Display *d, 2658 Drawable drawable, 2659 int sx, 2660 int sy, 2661 unsigned sw, 2662 unsigned sh, 2663 unsigned /* long */ mask, 2664 int format, 2665 XImage *image, 2666 int dx, 2667 int dy 2668) 2669{ 2670 XGetSubImage(d,drawable,sx,sy,sw,sh,mask,CImageFormat(format),image,dx,dy); 2671 2672 /* XFree((char *)image); */ 2673} 2674 2675static void PutImage 2676( 2677 Display *d, 2678 Drawable drawable, 2679 GC gc, 2680 XImage *image, 2681 int sx, 2682 int sy, 2683 int dx, 2684 int dy, 2685 unsigned dw, 2686 unsigned dh 2687) 2688{ 2689 XPutImage(d,drawable,gc,image,sx,sy,dx,dy,dw,dh); 2690 2691 /* XFree((char *)image); */ 2692} 2693 2694static Handle GetPixel(TaskData *taskData, XImage *image, int x, int y) 2695{ 2696 unsigned pixel = XGetPixel(image,x,y); 2697 2698 /* XFree((char *)image); */ 2699 2700 return Make_arbitrary_precision(taskData, pixel); 2701} 2702 2703static void PutPixel(XImage *image, int x, int y, unsigned pixel) 2704{ 2705 XPutPixel(image,x,y,pixel); 2706 2707 /* XFree((char *)image); */ 2708} 2709 2710static void AddPixel(XImage *image, unsigned value) 2711{ 2712 XAddPixel(image,value); 2713 2714 /* XFree((char *)image); */ 2715} 2716 2717 2718/******************************************************************************/ 2719/* */ 2720/* TimeVal */ 2721/* */ 2722/******************************************************************************/ 2723static int DoubleClickTime = 250; /* Double click time in milliseconds */ 2724static int MouseDrift = 5; /* Mouse movement allowed in button events */ 2725 2726static void NormaliseTime(TimeVal *t) 2727{ 2728 while(t->tv_usec >= 1000000) { t->tv_usec -= 1000000; t->tv_sec++; } 2729 while(t->tv_usec < 0) { t->tv_usec += 1000000; t->tv_sec--; } 2730} 2731 2732static void TimeAdd(TimeVal *a, TimeVal *b, TimeVal *t) 2733{ 2734 t->tv_sec = a->tv_sec + b->tv_sec; 2735 t->tv_usec = a->tv_usec + b->tv_usec; 2736 2737 NormaliseTime(t); 2738} 2739 2740static int TimeLt(TimeVal *a, TimeVal *b) 2741{ 2742 return ((a->tv_sec < b->tv_sec) || 2743 ((a->tv_sec == b->tv_sec) && (a->tv_usec < b->tv_usec))); 2744} 2745 2746static int TimeLeq(TimeVal *a, TimeVal *b) 2747{ 2748 return ((a->tv_sec < b->tv_sec) || 2749 ((a->tv_sec == b->tv_sec) && (a->tv_usec <= b->tv_usec))); 2750} 2751 2752/******************************************************************************/ 2753/* */ 2754/* (?) */ 2755/* */ 2756/******************************************************************************/ 2757typedef struct 2758{ 2759 XButtonEvent *button; /* initial button press event */ 2760 int up,down; /* count of button transitions */ 2761} PredicateArgs; 2762 2763static Bool SameClickEvent(Display *dpy, XEvent *ev, XPointer arg) 2764{ 2765 PredicateArgs *A = (PredicateArgs *)arg; 2766 2767 switch(ev->type) 2768 { 2769 case MotionNotify: 2770 { 2771 int dx = ev->xmotion.x - A->button->x; 2772 int dy = ev->xmotion.y - A->button->y; 2773 2774 if (ev->xmotion.window != A->button->window) return False; 2775 2776 if (abs(dx) > MouseDrift) return False; 2777 if (abs(dy) > MouseDrift) return False; 2778 2779 return True; 2780 } 2781 2782 case ButtonPress: 2783 case ButtonRelease: 2784 { 2785 int dx = ev->xbutton.x - A->button->x; 2786 int dy = ev->xbutton.y - A->button->y; 2787 2788 if (ev->xbutton.window != A->button->window) return False; 2789 2790 if (ev->xbutton.button != A->button->button) return False; 2791 2792 if (abs(dx) > MouseDrift) return False; 2793 if (abs(dy) > MouseDrift) return False; 2794 2795 if (ev->type == ButtonPress) A->down++; else A->up++; 2796 2797 return True; 2798 } 2799 } 2800 2801 return False; 2802} 2803 2804static void WaitDoubleClickTime(Handle dsHandle, PredicateArgs *A) 2805{ 2806 XEvent N; 2807 TimeVal start_time,end_time,dt; 2808 Display *d = DEREFDISPLAYHANDLE(dsHandle)->display; 2809 2810 /* 2811 AIX doesn't document support for NULL pointers in the select call, 2812 so we have to initialise empty fd_sets instead. SPF 30/10/95 2813 */ 2814 fd_set read_fds, write_fds, except_fds; 2815 FD_ZERO(&read_fds); 2816 FD_ZERO(&write_fds); 2817 FD_ZERO(&except_fds); 2818 2819 { 2820 int fd = d->fd; 2821 assert (0 <= fd && fd < FD_SETSIZE); 2822 FD_SET(fd,&read_fds); 2823 } 2824 2825 gettimeofday(&start_time, NULL); 2826 2827 dt.tv_sec = 0; 2828 dt.tv_usec = DoubleClickTime * 1000; 2829 2830 TimeAdd(&start_time,&dt,&end_time); 2831 2832 for (;;) 2833 { 2834 int extended = 0; 2835 2836 while(XCheckIfEvent(d,&N,SameClickEvent,(char *) A)) 2837 { 2838 if (DEREFDISPLAYHANDLE(dsHandle)->app_context) XtDispatchEvent(&N); 2839 2840 extended = 1; 2841 } 2842 2843 if (QLength(d)) break; /* some other event to be processed next */ 2844 2845 if (extended) /* button event extended, so extend time period */ 2846 { 2847 dt.tv_sec = 0; 2848 dt.tv_usec = DoubleClickTime * 1000; 2849 2850 TimeAdd(&end_time,&dt,&end_time); 2851 } 2852 2853 if (TimeLeq(&end_time,&start_time)) break; /* the time period has elapsed */ 2854 2855 select(FD_SETSIZE,&read_fds,&write_fds,&except_fds,&dt); 2856 2857 gettimeofday(&start_time, NULL); 2858 } 2859} 2860 2861static Handle GetKeyVector(TaskData *taskData, void *k, unsigned i) 2862{ 2863 uchar *keys = (uchar*)k; 2864 unsigned index = i / 8; 2865 unsigned mask = 1 << (i % 8); 2866 return Make_bool(keys[index] & mask); 2867} 2868 2869static Handle QueryKeymap(TaskData *taskData, Display *d) 2870{ 2871 char keys[32]; 2872 XQueryKeymap(d, keys); 2873 return CreateList4I(taskData, 256,keys,0,GetKeyVector); 2874} 2875 2876/******************************************************************************/ 2877/* */ 2878/* EventName */ 2879/* */ 2880/******************************************************************************/ 2881typedef struct 2882{ 2883 const char *name; 2884 int type; 2885} EventName; 2886 2887static EventName EventNames[] = 2888{ 2889 { "KeyPress",KeyPress }, 2890 { "KeyRelease",KeyRelease }, 2891 { "ButtonPress",ButtonPress }, 2892 { "ButtonRelease",ButtonRelease }, 2893 { "MotionNotify",MotionNotify }, 2894 { "EnterNotify",EnterNotify }, 2895 { "LeaveNotify",LeaveNotify }, 2896 { "FocusIn",FocusIn }, 2897 { "FocusOut",FocusOut }, 2898 { "KeymapNotify",KeymapNotify }, 2899 { "Expose",Expose }, 2900 { "GraphicsExpose",GraphicsExpose }, 2901 { "NoExpose",NoExpose }, 2902 { "VisibilityNotify",VisibilityNotify }, 2903 { "CreateNotify",CreateNotify }, 2904 { "DestroyNotify",DestroyNotify }, 2905 { "UnmapNotify",UnmapNotify }, 2906 { "MapNotify",MapNotify }, 2907 { "MapRequest",MapRequest }, 2908 { "ReparentNotify",ReparentNotify }, 2909 { "ConfigureNotify",ConfigureNotify }, 2910 { "ConfigureRequest",ConfigureRequest }, 2911 { "GravityNotify",GravityNotify }, 2912 { "ResizeRequest",ResizeRequest }, 2913 { "CirculateNotify",CirculateNotify }, 2914 { "CirculateRequest",CirculateRequest }, 2915 { "PropertyNotify",PropertyNotify }, 2916 { "SelectionClear",SelectionClear }, 2917 { "SelectionRequest",SelectionRequest }, 2918 { "SelectionNotify",SelectionNotify }, 2919 { "ColormapNotify",ColormapNotify }, 2920 { "ClientMessage",ClientMessage }, 2921 { "MappingNotify",MappingNotify }, 2922}; 2923 2924#define NEVENTS (sizeof(EventNames)/sizeof(EventName)) 2925 2926static const char *DebugEventName(int type) 2927{ 2928 for(unsigned i = 0; i < NEVENTS; i++) 2929 { 2930 if (EventNames[i].type == type) return EventNames[i].name; 2931 } 2932 2933 return "** BAD EVENT **"; 2934} 2935 2936static int WM_PROTOCOLS(Display *d) 2937{ 2938 static int protocols = None; 2939 2940 if (protocols == None) protocols = XInternAtom(d,"WM_PROTOCOLS",True); 2941 2942 return protocols; 2943} 2944 2945static Atom WM_DELETE_WINDOW(Display *d) 2946{ 2947 static Atom deleteWindow = None; 2948 2949 if (deleteWindow == None) deleteWindow = XInternAtom(d,"WM_DELETE_WINDOW",True); 2950 2951 return deleteWindow; 2952} 2953 2954/******************************************************************************/ 2955/* */ 2956/* Structures used by CreateEvent function. */ 2957/* */ 2958/* These typedefs should correspond with the tuples used by MakeXKeyEvent etc */ 2959/* */ 2960/******************************************************************************/ 2961 2962 2963typedef struct 2964{ 2965X_Window_Object *root; 2966X_Window_Object *subwindow; 2967PolyWord time; /* ML int */ 2968MLXPoint *pointer; 2969MLXPoint *rootPointer; 2970PolyWord modifiers; /* ML modifier (int) */ 2971PolyWord keycode; /* ML int */ 2972} ML_KeyEvent_Data; 2973 2974typedef struct 2975{ 2976X_Window_Object *root; 2977X_Window_Object *subwindow; 2978PolyWord time; /* ML int */ 2979MLXPoint *pointer; 2980MLXPoint *rootPointer; 2981PolyWord modifiers; /* ML modifier (int) */ 2982PolyWord button; /* ML int */ 2983} ML_ButtonEvent_Data; 2984 2985typedef struct 2986{ 2987X_Window_Object *root; 2988X_Window_Object *subwindow; 2989PolyWord time; /* ML int */ 2990MLXPoint *pointer; 2991MLXPoint *rootPointer; 2992PolyWord modifiers; /* ML modifier (int) */ 2993PolyWord button; /* ML int */ 2994PolyWord up; /* ML int */ 2995PolyWord down; /* ML int */ 2996} ML_ButtonClick_Data; 2997 2998typedef struct 2999{ 3000X_Window_Object *root; 3001X_Window_Object *subwindow; 3002PolyWord time; /* ML int */ 3003MLXPoint *pointer; 3004MLXPoint *rootPointer; 3005PolyWord modifiers; /* ML modifier (int) */ 3006PolyWord isHint; /* ML bool */ 3007} ML_MotionEvent_Data; 3008 3009 3010typedef struct 3011{ 3012X_Window_Object *root; 3013X_Window_Object *subwindow; 3014PolyWord time; /* ML int */ 3015MLXPoint *pointer; 3016MLXPoint *rootPointer; 3017PolyWord mode; /* ? */ 3018PolyWord detail; /* ? */ 3019PolyWord focus; /* ? */ 3020PolyWord modifiers; /* ML modifier (int) */ 3021} ML_CrossingEvent_Data; 3022 3023 3024typedef struct 3025{ 3026 MLXRectangle *region; 3027 PolyWord count; /* ML int */ 3028} ML_ExposeEvent_Data; 3029 3030typedef struct 3031{ 3032 X_Window_Object *window; 3033 MLXPoint *position; 3034 MLXRectangle *size; 3035 PolyWord borderWidth; /* ML int */ 3036 X_Window_Object *above; 3037 PolyWord overrideRedirect; /* ML bool */ 3038} ML_ConfigureNotify_Data; 3039 3040typedef struct 3041{ 3042 X_Window_Object *window; 3043 MLXPoint *position; 3044 MLXRectangle *size; 3045 PolyWord borderWidth; 3046 X_Window_Object *above; 3047 PolyWord detail; /* ? */ 3048} ML_ConfigureRequest_Data; 3049 3050 3051typedef struct 3052{ 3053 MLXRectangle *region; 3054 PolyWord count; /* ML int */ 3055 PolyWord code; /* ML int */ 3056} ML_GraphicsExposeEvent_Data; 3057 3058typedef struct 3059{ 3060 PolyWord mode; /* ML int ? */ 3061 PolyWord detail; /* ML int ? */ 3062 } ML_FocusChangeEvent_Data; 3063 3064typedef struct 3065{ 3066 X_Window_Object *window; 3067 MLXPoint *position; 3068 MLXRectangle *size; 3069 PolyWord borderWidth; /* ML int */ 3070 PolyWord overrideRedirect; /* ML bool */ 3071} ML_CreateEvent_Data; 3072 3073typedef struct 3074{ 3075 X_Window_Object *window; 3076 PolyWord fromConfigure; /* ML bool */ 3077} ML_UnmapEvent_Data; 3078 3079typedef struct 3080{ 3081 X_Window_Object *window; 3082 PolyWord overrideRedirect; /* ML bool */ 3083} ML_MapEvent_Data; 3084 3085typedef struct 3086{ 3087X_Window_Object *window; 3088X_Window_Object *parent; 3089MLXPoint *position; 3090PolyWord overrideRedirect; /* ML bool */ 3091} ML_ReparentEvent_Data; 3092 3093typedef struct 3094{ 3095X_Window_Object *window; 3096MLXPoint *position; 3097} ML_GravityEvent_Data; 3098 3099typedef struct 3100{ 3101X_Window_Object *window; 3102PolyWord place; 3103} ML_CirculateEvent_Data; 3104 3105typedef struct 3106{ 3107X_Colormap_Object *colormap_object; 3108PolyWord c_new; /* ML bool */ 3109PolyWord installed; /* ML bool */ 3110} ML_ColormapEvent_Data; 3111 3112typedef struct 3113{ 3114PolyWord selection; /* ML int */ 3115PolyWord time; /* ML int */ 3116} ML_SelectionClear_Data; 3117 3118typedef struct 3119{ 3120 X_Window_Object *requestor; 3121 PolyWord selection; /* ML int */ 3122 PolyWord target; /* ML int */ 3123 PolyWord property; /* ML int */ 3124 PolyWord time; /* ML int */ 3125} ML_SelectionRequest_Data; 3126 3127 3128typedef struct 3129{ 3130 PolyWord selection; /* ML int */ 3131 PolyWord target; /* ML int */ 3132 PolyWord property; /* ML int */ 3133 PolyWord time; /* ML int */ 3134} ML_Selection_Data; 3135 3136 3137class ML_Event: public PolyObject 3138{ 3139public: 3140 PolyWord type; /* ML (?) */ 3141 PolyWord sendEvent; /* ML bool */ 3142 PolyWord window; /* X_Window_Object* */ 3143 PolyWord data; /* pointer to event-specific data, in ML_XXX_Data format */ 3144 PolyWord callbacks; /* ML list of something */ 3145 PolyWord events; /* ML list */ 3146}; 3147 3148 3149/******************************************************************************/ 3150/* */ 3151/* CreateEvent function */ 3152/* */ 3153/******************************************************************************/ 3154 3155static Handle CreateEvent 3156( 3157 TaskData *taskData, 3158 Handle dsHandle, /* Handle to (X_Display_Object *) */ 3159 XEvent *ev, 3160 Handle W /* Handle to (X_Window_Object *) */ 3161) 3162{ 3163 Handle eventHandle = alloc_and_save(taskData, SIZEOF(ML_Event), F_MUTABLE_BIT); 3164 3165 Display *d = DEREFDISPLAYHANDLE(dsHandle)->display; 3166 int type = ev->xany.type; 3167 int send_event = ev->xany.send_event; 3168 3169 assert(d == ev->xany.display); 3170 3171 if (debugOptions & DEBUG_X) 3172 { 3173 printf("CreateEvent called, type=%s,", DebugEventName(type)); 3174 printf(" window=%lx\n", ev->xany.window); 3175 } 3176 3177#define event ((ML_Event *)DEREFHANDLE(eventHandle)) 3178 event->type = DEREFWORD(Make_arbitrary_precision(taskData, type)); 3179 event->sendEvent = DEREFWORD(Make_bool(send_event)); 3180 event->window = DEREFWINDOWHANDLE(W); 3181 3182 switch(type) 3183 { 3184 case KeyPress: 3185 case KeyRelease: 3186 { 3187 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_KeyEvent_Data), F_MUTABLE_BIT); 3188 3189#define data ((ML_KeyEvent_Data *)DEREFHANDLE(dataHandle)) 3190 data->root = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xkey.root)); 3191 data->subwindow = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xkey.subwindow)); 3192 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xkey.time)); 3193 data->pointer = (MLXPoint *)DEREFHANDLE(CreatePoint(taskData, ev->xkey.x,ev->xkey.y)); 3194 data->rootPointer = (MLXPoint *)DEREFHANDLE(CreatePoint(taskData, ev->xkey.x_root,ev->xkey.y_root)); 3195 data->modifiers = DEREFWORD(Make_arbitrary_precision(taskData, ev->xkey.state)); 3196 data->keycode = DEREFWORD(Make_arbitrary_precision(taskData, ev->xkey.keycode)); 3197#undef data 3198 3199 event->data = DEREFHANDLE(FINISHED(taskData, dataHandle)); 3200 3201 break; 3202 } 3203 3204 3205 case ButtonPress: 3206 case ButtonRelease: 3207 { 3208 3209 if (DEREFWINDOWHANDLE(W)->eventMask->Get(0).AsUnsigned() & ButtonClickMask) 3210 { 3211 Handle dataHandle; 3212 PredicateArgs A; 3213 3214 A.button = &ev->xbutton; 3215 A.up = (ev->type == ButtonRelease); 3216 A.down = (ev->type == ButtonPress); 3217 3218 WaitDoubleClickTime(dsHandle,&A); 3219 3220 dataHandle = alloc_and_save(taskData, SIZEOF(ML_ButtonClick_Data), F_MUTABLE_BIT); 3221 3222#define data ((ML_ButtonClick_Data *)DEREFHANDLE(dataHandle)) 3223 data->root = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xbutton.root)); 3224 data->subwindow = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xbutton.subwindow)); 3225 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.time)); 3226 data->pointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xbutton.x,ev->xbutton.y)); 3227 data->rootPointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xbutton.x_root,ev->xbutton.y_root)); 3228 data->modifiers = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.state)); 3229 data->button = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.button)); 3230 data->up = DEREFWORD(Make_arbitrary_precision(taskData, A.up)); 3231 data->down = DEREFWORD(Make_arbitrary_precision(taskData, A.down)); 3232#undef data 3233 3234 event->type = DEREFWORD(Make_arbitrary_precision(taskData, 42)); /* What's this for? */ 3235 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3236 3237 } 3238 else 3239 { 3240 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_ButtonEvent_Data), F_MUTABLE_BIT); 3241 3242#define data ((ML_ButtonEvent_Data *)DEREFHANDLE(dataHandle)) 3243 data->root = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xbutton.root)); 3244 data->subwindow = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xbutton.subwindow)); 3245 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.time)); 3246 data->pointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xbutton.x,ev->xbutton.y)); 3247 data->rootPointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xbutton.x_root,ev->xbutton.y_root)); 3248 data->modifiers = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.state)); 3249 data->button = DEREFWORD(Make_arbitrary_precision(taskData, ev->xbutton.button)); 3250#undef data 3251 3252 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3253 3254 } 3255 3256 break; 3257 } 3258 3259 3260 case MotionNotify: 3261 { 3262 3263 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_MotionEvent_Data), F_MUTABLE_BIT); 3264 3265#define data ((ML_MotionEvent_Data *)DEREFHANDLE(dataHandle)) 3266 data->root = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xmotion.root)); 3267 data->subwindow = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xmotion.subwindow)); 3268 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xmotion.time)); 3269 data->pointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xmotion.x,ev->xmotion.y)); 3270 data->rootPointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xmotion.x_root,ev->xmotion.y_root)); 3271 data->modifiers = DEREFWORD(Make_arbitrary_precision(taskData, ev->xmotion.state)); 3272 data->isHint = DEREFWORD(Make_arbitrary_precision(taskData, ev->xmotion.is_hint)); 3273#undef data 3274 3275 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3276 3277 3278 break; 3279 } 3280 3281 case EnterNotify: 3282 case LeaveNotify: 3283 { 3284 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_CrossingEvent_Data), F_MUTABLE_BIT); 3285 3286#define data ((ML_CrossingEvent_Data *)DEREFHANDLE(dataHandle)) 3287 data->root = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xcrossing.root)); 3288 data->subwindow = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xcrossing.subwindow)); 3289 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xcrossing.time)); 3290 data->pointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xcrossing.x,ev->xcrossing.y)); 3291 data->rootPointer = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xcrossing.x_root,ev->xcrossing.y_root)); 3292 data->mode = DEREFWORD(Make_arbitrary_precision(taskData, ev->xcrossing.mode)); 3293 data->detail = DEREFWORD(Make_arbitrary_precision(taskData, ev->xcrossing.detail)); 3294 data->focus = DEREFWORD(Make_bool(ev->xcrossing.focus)); 3295 data->modifiers = DEREFWORD(Make_arbitrary_precision(taskData, ev->xcrossing.state)); 3296#undef data 3297 3298 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3299 3300 break; 3301 } 3302 3303 case Expose: 3304 { 3305 int left = ev->xexpose.x; 3306 int top = ev->xexpose.y; 3307 int right = left + ev->xexpose.width; 3308 int bottom = top + ev->xexpose.height; 3309 3310 Handle dataHandle; 3311 3312 while(XCheckTypedWindowEvent(d,ev->xexpose.window,Expose,ev)) 3313 { 3314 int L = ev->xexpose.x; 3315 int T = ev->xexpose.y; 3316 int R = L + ev->xexpose.width; 3317 int B = T + ev->xexpose.height; 3318 3319 assert(ev->type == Expose); 3320 3321 left = min(left,L); 3322 top = min(top,T); 3323 right = max(right,R); 3324 bottom = max(bottom,B); 3325 } 3326 3327 dataHandle = alloc_and_save(taskData, SIZEOF(ML_ExposeEvent_Data), F_MUTABLE_BIT); 3328 3329#define data ((ML_ExposeEvent_Data *)DEREFHANDLE(dataHandle)) 3330 data->region = (MLXRectangle *)DEREFHANDLE(CreateRect(taskData, top,left,bottom,right)); 3331 data->count = DEREFWORD(Make_arbitrary_precision(taskData, 0)); 3332#undef data 3333 3334 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3335 3336 break; 3337 } 3338 3339 3340 case GraphicsExpose: 3341 { 3342 int left = ev->xgraphicsexpose.x; 3343 int top = ev->xgraphicsexpose.y; 3344 int right = left + ev->xgraphicsexpose.width; 3345 int bottom = top + ev->xgraphicsexpose.height; 3346 3347 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_GraphicsExposeEvent_Data), F_MUTABLE_BIT); 3348 3349#define data ((ML_GraphicsExposeEvent_Data *)DEREFHANDLE(dataHandle)) 3350 data->region = (MLXRectangle *)DEREFHANDLE(CreateRect(taskData, top,left,bottom,right)); 3351 data->count = DEREFWORD(Make_arbitrary_precision(taskData, ev->xgraphicsexpose.count)); 3352 data->code = DEREFWORD(Make_arbitrary_precision(taskData, ev->xgraphicsexpose.major_code)); 3353#undef data 3354 3355 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3356 3357 break; 3358 } 3359 3360 case NoExpose: 3361 { 3362 event->data = DEREFWORD(Make_arbitrary_precision(taskData, ev->xnoexpose.major_code)); 3363 3364 break; 3365 } 3366 3367 case ConfigureNotify: 3368 { 3369 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_ConfigureNotify_Data), F_MUTABLE_BIT); 3370 3371#define data ((ML_ConfigureNotify_Data *)DEREFHANDLE(dataHandle)) 3372 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xconfigure.window)); 3373 data->position = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xconfigure.x,ev->xconfigure.y)); 3374 data->size = (MLXRectangle *) DEREFHANDLE(CreateArea(ev->xconfigure.width,ev->xconfigure.height)); 3375 data->borderWidth = DEREFWORD(Make_int(ev->xconfigure.border_width)); 3376 data->above = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xconfigure.above)); 3377 data->overrideRedirect = DEREFWORD(Make_bool(ev->xconfigure.override_redirect)); 3378#undef data 3379 3380 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3381 3382 break; 3383 } 3384 3385 3386 3387 case FocusIn: 3388 case FocusOut: 3389 { 3390 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_FocusChangeEvent_Data), F_MUTABLE_BIT); 3391 3392#define data ((ML_FocusChangeEvent_Data *)DEREFHANDLE(dataHandle)) 3393 data->mode = DEREFWORD(Make_int(ev->xfocus.mode)); 3394 data->detail = DEREFWORD(Make_int(ev->xfocus.detail)); 3395#undef data 3396 3397 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3398 3399 break; 3400 } 3401 3402 case VisibilityNotify: 3403 { 3404 event->data = DEREFWORD(Make_int(ev->xvisibility.state)); 3405 3406 break; 3407 } 3408 3409 3410 case CreateNotify: 3411 { 3412 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_CreateEvent_Data), F_MUTABLE_BIT); 3413 3414#define data ((ML_CreateEvent_Data *)DEREFHANDLE(dataHandle)) 3415 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xcreatewindow.window)); 3416 data->position = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xcreatewindow.x,ev->xcreatewindow.y)); 3417 data->size = (MLXRectangle *) DEREFHANDLE(CreateArea(ev->xcreatewindow.width,ev->xcreatewindow.height)); 3418 data->borderWidth = DEREFWORD(Make_int(ev->xcreatewindow.border_width)); 3419 data->overrideRedirect = DEREFWORD(Make_bool(ev->xcreatewindow.override_redirect)); 3420#undef data 3421 3422 event->data = DEREFHANDLE(FINISHED(taskData, dataHandle)); 3423 3424 break; 3425 } 3426 3427 case DestroyNotify: 3428 { 3429 debugReclaim(Window,ev->xdestroywindow.window); 3430 event->data = DEREFWORD(EmptyWindow(taskData, dsHandle,ev->xdestroywindow.window)); 3431 3432 break; 3433 } 3434 3435 case UnmapNotify: 3436 { 3437 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_UnmapEvent_Data), F_MUTABLE_BIT); 3438 3439#define data ((ML_UnmapEvent_Data *)DEREFHANDLE(dataHandle)) 3440 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xunmap.window)); 3441 data->fromConfigure = DEREFWORD(Make_bool(ev->xunmap.from_configure)); 3442#undef data 3443 3444 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3445 3446 break; 3447 } 3448 3449 case MapNotify: 3450 { 3451 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_MapEvent_Data), F_MUTABLE_BIT); 3452 3453#define data ((ML_MapEvent_Data *)DEREFHANDLE(dataHandle)) 3454 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xmap.window)); 3455 data->overrideRedirect = DEREFWORD(Make_bool(ev->xmap.override_redirect)); 3456#undef data 3457 3458 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3459 3460 break; 3461 } 3462 3463 case MapRequest: 3464 { 3465 event->data = DEREFWORD(EmptyWindow(taskData, dsHandle,ev->xmaprequest.window)); 3466 3467 break; 3468 } 3469 3470 3471 case ReparentNotify: 3472 { 3473 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_ReparentEvent_Data), F_MUTABLE_BIT); 3474 3475#define data ((ML_ReparentEvent_Data *)DEREFHANDLE(dataHandle)) 3476 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xreparent.window)); 3477 data->parent = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xreparent.parent)); 3478 data->position = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xreparent.x,ev->xreparent.y)); 3479 data->overrideRedirect = DEREFWORD(Make_bool(ev->xreparent.override_redirect)); 3480#undef data 3481 3482 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3483 3484 break; 3485 } 3486 3487 3488 case ConfigureRequest: 3489 { 3490 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_ConfigureRequest_Data), F_MUTABLE_BIT); 3491 3492#define data ((ML_ConfigureRequest_Data *)DEREFHANDLE(dataHandle)) 3493 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xconfigurerequest.window)); 3494 data->position = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xconfigurerequest.x,ev->xconfigurerequest.y)); 3495 data->size = (MLXRectangle *) DEREFHANDLE(CreateArea(ev->xconfigurerequest.width,ev->xconfigurerequest.height)); 3496 data->borderWidth = DEREFWORD(Make_int(ev->xconfigurerequest.border_width)); 3497 data->above = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xconfigurerequest.above)); 3498 data->detail = DEREFWORD(Make_int(ev->xconfigurerequest.detail)); 3499#undef data 3500 3501 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3502 3503 break; 3504 } 3505 3506 case GravityNotify: 3507 { 3508 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_GravityEvent_Data), F_MUTABLE_BIT); 3509 3510#define data ((ML_GravityEvent_Data *)DEREFHANDLE(dataHandle)) 3511 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xgravity.window)); 3512 data->position = (MLXPoint *) DEREFHANDLE(CreatePoint(taskData, ev->xgravity.x,ev->xgravity.y)); 3513#undef data 3514 3515 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3516 3517 break; 3518 } 3519 3520 case ResizeRequest: 3521 { 3522 event->data = DEREFWORD(CreateArea(ev->xresizerequest.width,ev->xresizerequest.height)); 3523 3524 break; 3525 } 3526 3527 3528 case CirculateNotify: 3529 { 3530 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_CirculateEvent_Data), F_MUTABLE_BIT); 3531 3532#define data ((ML_CirculateEvent_Data *)DEREFHANDLE(dataHandle)) 3533 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xcirculate.window)); 3534 data->place = DEREFWORD(Make_int(ev->xcirculate.place)); 3535#undef data 3536 3537 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3538 3539 break; 3540 } 3541 3542 case CirculateRequest: 3543 { 3544 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_CirculateEvent_Data), F_MUTABLE_BIT); 3545 3546#define data ((ML_CirculateEvent_Data *)DEREFHANDLE(dataHandle)) 3547 data->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xcirculaterequest.window)); 3548 data->place = DEREFWORD(Make_int(ev->xcirculaterequest.place)); 3549#undef data 3550 3551 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3552 3553 break; 3554 } 3555 3556 case ColormapNotify: 3557 { 3558 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_ColormapEvent_Data), F_MUTABLE_BIT); 3559 3560#define data ((ML_ColormapEvent_Data *)DEREFHANDLE(dataHandle)) 3561 data->colormap_object = (X_Colormap_Object *)DEREFHANDLE(EmptyColormap(taskData, dsHandle,ev->xcolormap.colormap)); 3562 data->c_new = DEREFWORD(Make_bool(ev->xcolormap.c_new)); 3563 data->installed = DEREFWORD(Make_bool(ev->xcolormap.state == ColormapInstalled)); 3564#undef data 3565 3566 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3567 3568 break; 3569 } 3570 3571 case MappingNotify: 3572 { 3573 XRefreshKeyboardMapping((XMappingEvent *)ev); /* cast added SPF 6/1/94 */ 3574 return 0; /* HACK !!!! */ 3575 } 3576 3577 case SelectionClear: 3578 { 3579 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_SelectionClear_Data), F_MUTABLE_BIT); 3580 3581#define data ((ML_SelectionClear_Data *)DEREFHANDLE(dataHandle)) 3582 data->selection = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionclear.selection)); 3583 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionclear.time)); 3584#undef data 3585 3586 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3587 3588 break; 3589 } 3590 3591 case SelectionNotify: 3592 { 3593 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_Selection_Data), F_MUTABLE_BIT); 3594 3595#define data ((ML_Selection_Data *)DEREFHANDLE(dataHandle)) 3596 data->selection = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselection.selection)); 3597 data->target = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselection.target)); 3598 data->property = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselection.property)); 3599 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselection.time)); 3600#undef data 3601 3602 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3603 3604 break; 3605 } 3606 3607 case SelectionRequest: 3608 { 3609 Handle dataHandle = alloc_and_save(taskData, SIZEOF(ML_SelectionRequest_Data), F_MUTABLE_BIT); 3610 3611#define data ((ML_SelectionRequest_Data *)DEREFHANDLE(dataHandle)) 3612 data->requestor = DEREFWINDOWHANDLE(EmptyWindow(taskData, dsHandle,ev->xselectionrequest.requestor)); 3613 data->selection = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionrequest.selection)); 3614 data->target = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionrequest.target)); 3615 data->property = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionrequest.property)); 3616 data->time = DEREFWORD(Make_arbitrary_precision(taskData, ev->xselectionrequest.time)); 3617#undef data 3618 3619 event->data = DEREFWORD(FINISHED(taskData, dataHandle)); 3620 3621 break; 3622 } 3623 3624 case ClientMessage: 3625 { 3626 unsigned protocols = WM_PROTOCOLS(d); 3627 int deleteWindow = WM_DELETE_WINDOW(d); 3628 3629 if (protocols != None && 3630 deleteWindow != None && 3631 ev->xclient.message_type == protocols && 3632 ev->xclient.format == 32 && 3633 ev->xclient.data.l[0] == deleteWindow) 3634 { 3635 event->type = DEREFWORD(Make_arbitrary_precision(taskData, 43)); /* (?) */ 3636 3637 break; 3638 } 3639 else return 0; 3640 } 3641 3642 case PropertyNotify: return 0; 3643 3644 case KeymapNotify: return 0; /* Broken: the window field does not tell me the window requesting this event */ 3645 3646 default: Crash ("Bad event type %x",ev->type); 3647 } 3648 3649 event->callbacks = FList; /* Safe, since FList is a Root */ 3650 FList = TAGGED(0); 3651 3652 event->events = GList; /* Safe, since GList is a Root */ 3653 GList = TAGGED(0); 3654 3655 return FINISHED(taskData, eventHandle); 3656#undef event 3657} 3658 3659/******************************************************************************/ 3660/* */ 3661/* HERE */ 3662/* */ 3663/******************************************************************************/ 3664static Handle LookupString(TaskData *taskData, Display *d, unsigned keycode, unsigned modifiers) 3665{ 3666 XKeyEvent ev; 3667 int n; 3668 KeySym keysym; /* was int SPF 6/1/94 */ 3669 char buffer[500]; 3670 3671 ev.display = d; 3672 ev.keycode = keycode; 3673 ev.state = modifiers; 3674 3675 n = XLookupString(&ev,buffer,sizeof(buffer)-1,&keysym,NULL); 3676 3677 buffer[n] = '\0'; 3678 3679 return CreatePair(taskData, Make_string(buffer),Make_arbitrary_precision(taskData, keysym)); 3680} 3681 3682static Handle GetScreenSaver(TaskData *taskData, Display *d) 3683{ 3684 int timeout,interval,blanking,exposures; 3685 Handle tuple; 3686 3687 XGetScreenSaver(d,&timeout,&interval,&blanking,&exposures); 3688 3689 tuple = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 3690 3691#define data DEREFHANDLE(tuple) 3692 data->Set(0, DEREFWORD(Make_int(timeout))); 3693 data->Set(1, DEREFWORD(Make_int(interval))); 3694 data->Set(2, DEREFWORD(Make_arbitrary_precision(taskData, blanking))); 3695 data->Set(3, DEREFWORD(Make_arbitrary_precision(taskData, exposures))); 3696#undef data 3697 3698 return FINISHED(taskData, tuple); 3699} 3700 3701static Handle TranslateCoordinates 3702( 3703 TaskData *taskData, 3704 Handle dsHandle, /* Handle to (X_Display_Object *) */ 3705 Window src, 3706 Window dst, 3707 int x, 3708 int y 3709) 3710{ 3711 Window child; 3712 int dx,dy,s; 3713 3714 s = XTranslateCoordinates(DEREFDISPLAYHANDLE(dsHandle)->display,src,dst,x,y,&dx,&dy,&child); 3715 3716 if (s == 0) RaiseXWindows(taskData, "XTranslateCoordinates failed"); 3717 3718 return CreatePair(taskData, CreatePoint(taskData, dx,dy),EmptyWindow(taskData, dsHandle,child)); 3719} 3720 3721 3722static Handle QueryBest 3723( 3724 TaskData *taskData, 3725 int (*f)(Display*, Drawable, unsigned, unsigned, unsigned *, unsigned *), 3726 Display *d, 3727 Drawable drawable, 3728 unsigned width, 3729 unsigned height 3730 ) 3731{ 3732 unsigned W,H; 3733 3734 int s = (* f)(d,drawable,width,height,&W,&H); 3735 3736 if (s == 0) RaiseXWindows(taskData, "XQueryBest failed"); 3737 3738 return CreateArea(W,H); 3739} 3740 3741static Handle QueryPointer 3742( 3743 TaskData *taskData, 3744 Handle dsHandle, /* Handle to (X_Display_Object *) */ 3745 Window w 3746) 3747{ 3748 Window root,child; 3749 int rootX,rootY; 3750 int winX,winY; 3751 unsigned mask; 3752 int s; 3753 Handle tuple; 3754 3755 s = XQueryPointer(DEREFDISPLAYHANDLE(dsHandle)->display,w,&root,&child,&rootX,&rootY,&winX,&winY,&mask); 3756 3757 tuple = alloc_and_save(taskData, 6, F_MUTABLE_BIT); 3758 3759#define data DEREFHANDLE(tuple) 3760 data->Set(0, DEREFWORD(Make_arbitrary_precision(taskData, s))); 3761 data->Set(1, DEREFWORD(EmptyWindow(taskData, dsHandle,root))); 3762 data->Set(2, DEREFWORD(EmptyWindow(taskData, dsHandle,child))); 3763 data->Set(3, DEREFWORD(CreatePoint(taskData, rootX,rootY))); 3764 data->Set(4, DEREFWORD(CreatePoint(taskData, winX,winY))); 3765 data->Set(5, DEREFWORD(Make_arbitrary_precision(taskData, mask))); 3766#undef data 3767 3768 return FINISHED(taskData, tuple); 3769} 3770 3771static Handle ReadBitmap 3772( 3773 TaskData *taskData, 3774 Handle dsHandle, /* handle to (X_Display_Object *) */ 3775 Drawable w, 3776 PolyStringObject *string 3777) 3778{ 3779 unsigned width,height; 3780 char name[500]; 3781 int s,xhot,yhot; 3782 Pixmap pixmap; 3783 Handle tuple; 3784 3785 Poly_string_to_C(string,name,sizeof(name)); 3786 3787 s = XReadBitmapFile(DEREFDISPLAYHANDLE(dsHandle)->display,w,name,&width,&height,&pixmap,&xhot,&yhot); 3788 3789 tuple = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 3790 3791#define data DEREFHANDLE(tuple) 3792 3793 data->Set(0,DEREFWORD(Make_arbitrary_precision(taskData, s))); 3794 3795 if (s == BitmapSuccess) 3796 { 3797 data->Set(1, DEREFWORD(EmptyPixmap(taskData, dsHandle,pixmap))); 3798 data->Set(2, DEREFWORD(CreateArea(width,height))); 3799 data->Set(3, DEREFWORD(CreatePoint(taskData, xhot,yhot))); 3800 } 3801 3802 /******************** What if we don't succeed? Badly-formed tuple !!!! */ 3803 3804#undef data 3805 3806 return FINISHED(taskData, tuple); 3807} 3808 3809static Handle WriteBitmapFile 3810( 3811 TaskData *taskData, 3812 PolyStringObject *string, 3813 Display *d, 3814 Pixmap bitmap, 3815 unsigned w, 3816 unsigned h, 3817 int x, 3818 int y 3819) 3820{ 3821 char name[500]; int s; 3822 3823 Poly_string_to_C(string,name,sizeof(name)); 3824 3825 s = XWriteBitmapFile(d,name,bitmap,w,h,x,y); 3826 3827 return Make_arbitrary_precision(taskData, s); 3828} 3829 3830static Handle GetDefault(TaskData *taskData, Display *d, PolyStringObject *s1, PolyStringObject *s2) 3831{ 3832 char program[500]; char option[500]; char *s; 3833 3834 Poly_string_to_C(s1,program,sizeof(program)); 3835 Poly_string_to_C(s2,option ,sizeof(option)); 3836 3837 s = XGetDefault(d,program,option); 3838 3839 if (s == NULL) RaiseXWindows(taskData, "XGetDefault failed"); 3840 3841 return Make_string(s); 3842} 3843 3844 3845static void GetWindows(TaskData *taskData, PolyWord p, void *w, unsigned) 3846{ 3847 *(Window *)w = GetWindow(taskData, (X_Object *)p.AsObjPtr()); 3848} 3849 3850 3851static void GetSegments(TaskData *taskData, PolyWord pp, void *w, unsigned) 3852{ 3853 XSegment *A = (XSegment *)w; 3854 PolyObject *p = pp.AsObjPtr(); 3855 A->x1 = GetPointX(taskData, p->Get(0)); 3856 A->y1 = GetPointY(taskData, p->Get(0)); 3857 A->x2 = GetPointX(taskData, p->Get(1)); 3858 A->y2 = GetPointY(taskData, p->Get(1)); 3859} 3860 3861static void GetChar2(TaskData *taskData, PolyWord p, void *v, unsigned) 3862{ 3863 XChar2b *A = (XChar2b *)v; 3864 unsigned short u = get_C_ushort(taskData, p); 3865 A->byte1 = u >> 8; 3866 A->byte2 = u &0xFF; 3867} 3868 3869static void CopyString(TaskData *, PolyWord w, void *v, unsigned) 3870{ 3871 char **p = (char**)v; 3872 PolyStringObject *s = GetString(w); 3873 POLYUNSIGNED n = s->length+1; 3874 *p = (char*)malloc(n); 3875 Poly_string_to_C(s,*p,n); 3876} 3877 3878static void GetText(TaskData *taskData, PolyWord p, void *w, unsigned) 3879{ 3880 XTextItem *A = (XTextItem *)w; 3881 PolyObject *obj = p.AsObjPtr(); 3882 CopyString(taskData, obj->Get(0), &A->chars, 0); 3883 3884 A->nchars = strlen(A->chars); 3885 A->delta = get_C_short(taskData, obj->Get(1)); 3886 A->font = GetFont(taskData, (X_Object *)obj->Get(2).AsObjPtr()); 3887} 3888 3889static void GetText16(TaskData *taskData, PolyWord p, void *v, unsigned) 3890{ 3891 XTextItem16 *A = (XTextItem16 *)v; 3892 PolyObject *obj = p.AsObjPtr(); 3893 unsigned N = ListLength(obj->Get(0)); 3894 XChar2b *L = (XChar2b *) malloc(N * sizeof(XChar2b)); 3895 3896 GetList4(taskData,obj->Get(0),L,sizeof(XChar2b),GetChar2); 3897 3898 A->chars = L; 3899 A->nchars = N; 3900 A->delta = get_C_short(taskData, obj->Get(1)); 3901 A->font = GetFont(taskData, (X_Object *)obj->Get(2).AsObjPtr()); 3902} 3903 3904typedef void (*GetFunc)(TaskData *taskData, PolyWord, void*, unsigned); 3905 3906static void SetClipRectangles 3907( 3908 TaskData *taskData, 3909 Display *d, 3910 GC gc, 3911 int x, 3912 int y, 3913 Handle list, 3914 unsigned order 3915) 3916{ 3917 if (ISNIL(DEREFWORD(list))) 3918 { 3919 XSetClipRectangles(d,gc,x,y,NULL,0,order); 3920 } 3921 else 3922 { 3923 unsigned N = ListLength(DEREFWORD(list)); 3924 XRectangle *L = (XRectangle *) alloca(N * sizeof(XRectangle)); 3925 3926 GetList4(taskData, DEREFWORD(list),L,sizeof(XRectangle),GetRects); 3927 3928 XSetClipRectangles(d,gc,x,y,L,N,order); 3929 } 3930} 3931 3932static void GetUChars(TaskData *taskData, PolyWord p, void *u, unsigned) 3933{ 3934 *(uchar*)u = get_C_uchar(taskData, p); 3935} 3936 3937static void SetDashes 3938( 3939 TaskData *taskData, 3940 Display *d, 3941 GC gc, 3942 unsigned offset, 3943 Handle list 3944 ) 3945{ 3946 if (NONNIL(DEREFWORD(list))) 3947 { 3948 unsigned N = ListLength(DEREFWORD(list)); 3949 char *D = (char *) alloca(N); 3950 3951 GetList4(taskData,DEREFWORD(list),D,sizeof(uchar),GetUChars); 3952 3953 XSetDashes(d,gc,offset,D,N); 3954 } 3955} 3956 3957static Handle CreateDrawable 3958( 3959 TaskData *taskData, 3960 void *p, 3961 Handle dsHandle /* Handle to (X_Display_Object *) */ 3962) 3963{ 3964 return EmptyWindow(taskData, dsHandle,*(Window*)p); 3965} 3966 3967static Handle QueryTree 3968( 3969 TaskData *taskData, 3970 Handle dsHandle, /* Handle to (X_Display_Object *) */ 3971 Window w 3972) 3973{ 3974 Window root,parent,*children; 3975 unsigned n; 3976 Handle data; 3977 3978 int s = XQueryTree(DEREFDISPLAYHANDLE(dsHandle)->display,w,&root,&parent,&children,&n); 3979 3980 if (s == 0) RaiseXWindows(taskData, "XQueryTree failed"); 3981 3982 data = CreateTriple(taskData, EmptyWindow(taskData, dsHandle,root), 3983 EmptyWindow(taskData, dsHandle,parent), 3984 CreateList5(taskData, n,children,sizeof(Window),CreateDrawable,dsHandle)); 3985 3986 if (n) XFree((char *)children); 3987 3988 return data; 3989} 3990 3991static void RestackWindows(TaskData *taskData, Handle list /* handle to list of X_Window_Objects (?) */) 3992{ 3993 if (NONNIL(DEREFWORD(list))) 3994 { 3995 unsigned N = ListLength(DEREFWORD(list)); 3996 Window *W = (Window *) alloca(N * sizeof(Window)); 3997 Display *d = GetDisplay(taskData, (X_Object *)DEREFLISTHANDLE(list)->h.AsObjPtr()); 3998 3999 GetList4(taskData, DEREFWORD(list),W,sizeof(Window),GetWindows); 4000 4001 XRestackWindows(d,W,N); 4002 } 4003} 4004 4005static Handle GetGeometry 4006( 4007 TaskData *taskData, 4008 Handle dsHandle, /* Handle to (X_Display_Object *) */ 4009 Drawable w 4010) 4011{ 4012 int x,y; 4013 unsigned width,height,borderWidth,depth; 4014 Window root; 4015 Handle dataHandle; 4016 4017 int s = XGetGeometry(DEREFDISPLAYHANDLE(dsHandle)->display,w,&root,&x,&y,&width,&height,&borderWidth,&depth); 4018 4019 if (s == 0) RaiseXWindows(taskData, "XGetGeometry failed"); 4020 4021 dataHandle = alloc_and_save(taskData, 5, F_MUTABLE_BIT); 4022 4023#define data DEREFHANDLE(dataHandle) 4024 data->Set(0, DEREFWORD(EmptyWindow(taskData, dsHandle,root))); 4025 data->Set(1, DEREFWORD(CreatePoint(taskData, x,y))); 4026 data->Set(2, DEREFWORD(CreateArea(width,height))); 4027 data->Set(3, DEREFWORD(Make_arbitrary_precision(taskData, borderWidth))); 4028 data->Set(4, DEREFWORD(Make_arbitrary_precision(taskData, depth))); 4029#undef data 4030 4031 return FINISHED(taskData, dataHandle); 4032} 4033 4034static Handle GetWindowAttributes 4035( 4036 TaskData *taskData, 4037 Handle dsHandle, /* Handle to (X_Display_Object *) */ 4038 Drawable w 4039) 4040{ 4041 XWindowAttributes wa; 4042 Handle dataHandle; 4043 4044 int s = XGetWindowAttributes(DEREFDISPLAYHANDLE(dsHandle)->display,w,&wa); 4045 4046 if (s == 0) RaiseXWindows(taskData, "XGetWindowAttributes failed"); 4047 4048 dataHandle = alloc_and_save(taskData, 20, F_MUTABLE_BIT); 4049 4050/* HACKY - should define struct? */ 4051 DEREFHANDLE(dataHandle)->Set( 0, DEREFWORD(CreatePoint(taskData, wa.x,wa.y))); 4052 DEREFHANDLE(dataHandle)->Set( 1, DEREFWORD(CreateArea(wa.width,wa.height))); 4053 DEREFHANDLE(dataHandle)->Set( 2, DEREFWORD(Make_int(wa.border_width))); 4054 DEREFHANDLE(dataHandle)->Set( 3, DEREFWORD(Make_arbitrary_precision(taskData, wa.depth))); 4055 DEREFHANDLE(dataHandle)->Set( 4, DEREFWORD(EmptyVisual(taskData, dsHandle,wa.visual))); 4056 DEREFHANDLE(dataHandle)->Set( 5, DEREFWORD(EmptyWindow(taskData, dsHandle,wa.root))); 4057 DEREFHANDLE(dataHandle)->Set( 6, DEREFWORD(Make_arbitrary_precision(taskData, wa.c_class))); 4058 DEREFHANDLE(dataHandle)->Set( 7, DEREFWORD(Make_arbitrary_precision(taskData, wa.bit_gravity))); 4059 DEREFHANDLE(dataHandle)->Set( 8, DEREFWORD(Make_arbitrary_precision(taskData, wa.win_gravity))); 4060 DEREFHANDLE(dataHandle)->Set( 9, DEREFWORD(Make_arbitrary_precision(taskData, wa.backing_store))); 4061 DEREFHANDLE(dataHandle)->Set(10, DEREFWORD(Make_arbitrary_precision(taskData, wa.backing_planes))); 4062 DEREFHANDLE(dataHandle)->Set(11, DEREFWORD(Make_arbitrary_precision(taskData, wa.backing_pixel))); 4063 DEREFHANDLE(dataHandle)->Set(12, DEREFWORD(Make_bool(wa.save_under))); 4064 DEREFHANDLE(dataHandle)->Set(13, DEREFWORD(EmptyColormap(taskData, dsHandle,wa.colormap))); 4065 DEREFHANDLE(dataHandle)->Set(14, DEREFWORD(Make_bool(wa.map_installed))); 4066 DEREFHANDLE(dataHandle)->Set(15, DEREFWORD(Make_arbitrary_precision(taskData, wa.map_state))); 4067 DEREFHANDLE(dataHandle)->Set(16, DEREFWORD(Make_arbitrary_precision(taskData, wa.all_event_masks))); 4068 DEREFHANDLE(dataHandle)->Set(17, DEREFWORD(Make_arbitrary_precision(taskData, wa.your_event_mask))); 4069 DEREFHANDLE(dataHandle)->Set(18, DEREFWORD(Make_arbitrary_precision(taskData, wa.do_not_propagate_mask))); 4070 DEREFHANDLE(dataHandle)->Set(19, DEREFWORD(Make_bool(wa.override_redirect))); 4071 4072 return FINISHED(taskData, dataHandle); 4073} 4074 4075static void ChangeWindowAttributes 4076( 4077 TaskData *taskData, 4078 X_Window_Object *W, 4079 unsigned n, 4080 PolyWord P 4081) 4082{ 4083 XSetWindowAttributes a; 4084 4085 unsigned mask = 1 << n; 4086 4087 switch(mask) 4088 { 4089 case CWBitGravity: a.bit_gravity = get_C_ulong(taskData, P); break; 4090 case CWWinGravity: a.win_gravity = get_C_ulong(taskData, P); break; 4091 case CWBackingStore: a.backing_store = get_C_ulong(taskData, P); break; 4092 case CWBackingPlanes: a.backing_planes = get_C_ulong(taskData, P); break; 4093 case CWBackingPixel: a.backing_pixel = get_C_ulong(taskData, P); break; 4094 case CWOverrideRedirect: a.override_redirect = get_C_ulong(taskData, P); break; 4095 case CWSaveUnder: a.save_under = get_C_ulong(taskData, P); break; 4096 case CWEventMask: a.event_mask = get_C_ulong(taskData, P); break; 4097 case CWDontPropagate: a.do_not_propagate_mask = get_C_ulong(taskData, P); break; 4098 4099 case CWBackPixel: a.background_pixel = get_C_ulong(taskData, P); 4100 W->backgroundPixmap = 0; 4101 break; 4102 4103 case CWBackPixmap: a.background_pixmap = GetPixmap(taskData, (X_Object *)P.AsObjPtr()); 4104 W->backgroundPixmap = PixmapObject((X_Object *)P.AsObjPtr()); 4105 break; 4106 4107 case CWBorderPixel: a.border_pixel = get_C_ulong(taskData, P); 4108 W->borderPixmap = 0; 4109 break; 4110 4111 case CWBorderPixmap: a.border_pixmap = GetPixmap(taskData, (X_Object *)P.AsObjPtr()); 4112 W->borderPixmap = PixmapObject((X_Object *)P.AsObjPtr()); 4113 break; 4114 4115 case CWColormap: a.colormap = GetColormap(taskData, (X_Object *)P.AsObjPtr()); 4116 W->colormap_object = ColormapObject((X_Object *)P.AsObjPtr()); 4117 break; 4118 4119 case CWCursor: a.cursor = GetCursor(taskData, (X_Object *)P.AsObjPtr()); 4120 W->cursor_object = CursorObject((X_Object *)P.AsObjPtr()); 4121 break; 4122 4123 default: Crash ("Bad window mask %u",mask); 4124 } 4125 4126 XChangeWindowAttributes(GetDisplay(taskData, (X_Object *)W),GetWindow(taskData, (X_Object *)W),mask,&a); 4127} 4128 4129 4130static void ConfigureWindow 4131( 4132 TaskData *taskData, 4133 Display *d, 4134 Window w, 4135 PolyWord tup /* (P,S,w,d,s,flags) */ 4136) 4137{ 4138 PolyObject *tuple = tup.AsObjPtr(); 4139 XWindowChanges wc; 4140 4141 unsigned mask = get_C_ulong(taskData, tuple->Get(5)); 4142 4143 CheckZeroRect(taskData, tuple->Get(1)); 4144 4145 wc.x = GetPointX (taskData,tuple->Get(0)); 4146 wc.y = GetPointY (taskData,tuple->Get(0)); 4147 wc.width = GetRectW (taskData,tuple->Get(1)); 4148 wc.height = GetRectH (taskData,tuple->Get(1)); 4149 wc.border_width = get_C_ulong(taskData, tuple->Get(2)); 4150 wc.sibling = GetWindow (taskData,(X_Object *)tuple->Get(3).AsObjPtr()); 4151 wc.stack_mode = get_C_ulong(taskData, tuple->Get(4)); 4152 4153 XConfigureWindow(d,w,mask,&wc); 4154} 4155 4156 4157 4158/* The order of these depends on the XColor datatype */ 4159 4160typedef struct 4161{ 4162 PolyWord red; /* ML bool */ 4163 PolyWord blue; /* ML bool */ 4164 PolyWord doRed; /* ML bool */ 4165 PolyWord green; /* ML int */ 4166 PolyWord pixel; /* ML int */ 4167 PolyWord doBlue; /* ML int */ 4168 PolyWord doGreen; /* ML int */ 4169} MLXColor; /* in Poly heap */ 4170 4171static void ClearXColor(XColor *x) 4172{ 4173 x->red = x->green = x->blue = x->pixel = x->flags = 0; 4174} 4175 4176static Handle CreateXColor(TaskData *taskData, XColor *x) 4177{ 4178 Handle XHandle = alloc_and_save(taskData, SIZEOF(MLXColor), F_MUTABLE_BIT); 4179 4180#define X ((MLXColor *)DEREFHANDLE(XHandle)) 4181 X->red = DEREFWORD(Make_arbitrary_precision(taskData, x->red)); 4182 X->green = DEREFWORD(Make_arbitrary_precision(taskData, x->green)); 4183 X->blue = DEREFWORD(Make_arbitrary_precision(taskData, x->blue)); 4184 X->pixel = DEREFWORD(Make_arbitrary_precision(taskData, x->pixel)); 4185 X->doRed = DEREFWORD(Make_bool(x->flags &DoRed)); 4186 X->doGreen = DEREFWORD(Make_bool(x->flags &DoGreen)); 4187 X->doBlue = DEREFWORD(Make_bool(x->flags &DoBlue)); 4188#undef X 4189 4190 return FINISHED(taskData, XHandle); 4191} 4192 4193static Handle CreateXColorF(TaskData *taskData, void *p) 4194{ 4195 return CreateXColor(taskData, (XColor*)p); 4196} 4197 4198static XColor xcolor1 = { 0 }; 4199static XColor xcolor2 = { 0 }; 4200 4201static void GetXColor(TaskData *taskData, PolyWord p, void *v, unsigned) 4202{ 4203 MLXColor *P = (MLXColor *)p.AsObjPtr(); 4204 XColor *x = (XColor *)v; 4205 x->red = get_C_ushort(taskData, P->red); 4206 x->green = get_C_ushort(taskData, P->green); 4207 x->blue = get_C_ushort(taskData, P->blue); 4208 x->pixel = get_C_ulong (taskData, P->pixel); 4209 4210 x->flags = (DoRed * get_C_ulong(taskData, P->doRed)) 4211 | (DoGreen * get_C_ulong(taskData, P->doGreen)) 4212 | (DoBlue * get_C_ulong(taskData, P->doBlue)); 4213} 4214 4215static XColor *GetXColor1(TaskData *taskData, PolyWord P) 4216{ 4217 GetXColor(taskData, P, &xcolor1, 0); 4218 return &xcolor1; 4219} 4220 4221static XColor *GetXColor2(TaskData *taskData, PolyWord P) 4222{ 4223 GetXColor(taskData, P, &xcolor2, 0); 4224 return &xcolor2; 4225} 4226 4227static Handle AllocColor(TaskData *taskData, Display *d, Colormap cmap, XColor *x) 4228{ 4229 int s = XAllocColor(d,cmap,x); 4230 4231 if (s == 0) RaiseXWindows(taskData, "XAllocColor failed"); 4232 4233 return CreateXColor(taskData, x); 4234} 4235 4236static Handle CreateUnsigned(TaskData *taskData, void *q) 4237{ 4238 unsigned *p = (unsigned *)q; 4239 return Make_arbitrary_precision(taskData, *p); 4240} 4241 4242static Handle CreateUnsignedLong(TaskData *taskData, void *p) 4243{ 4244 return Make_arbitrary_precision(taskData, *(unsigned long*)p); 4245} 4246 4247static Handle AllocColorCells 4248( 4249 TaskData *taskData, 4250 Display *d, 4251 Colormap cmap, 4252 unsigned contig, 4253 unsigned nplanes, 4254 unsigned ncolors 4255) 4256{ 4257 unsigned long *masks; /* was unsigned SPF 6/1/94 */ 4258 unsigned long *pixels; /* was unsigned SPF 6/1/94 */ 4259 int s; 4260 4261 if (ncolors < 1) RaiseRange(taskData); 4262 4263 masks = (unsigned long *) alloca(nplanes * sizeof(unsigned long)); 4264 pixels = (unsigned long *) alloca(ncolors * sizeof(unsigned long)); 4265 4266 s = XAllocColorCells(d,cmap,contig,masks,nplanes,pixels,ncolors); 4267 4268 if (s == 0) RaiseXWindows (taskData, "XAllocColorCells failed"); 4269 4270 return CreatePair(taskData, CreateList4(taskData,nplanes,masks ,sizeof(unsigned long),CreateUnsignedLong), 4271 CreateList4(taskData,ncolors,pixels,sizeof(unsigned long),CreateUnsignedLong)); 4272} 4273 4274static Handle AllocColorPlanes 4275( 4276 TaskData *taskData, 4277 Display *d, 4278 Colormap cmap, 4279 unsigned contig, 4280 unsigned ncolors, 4281 unsigned nreds, 4282 unsigned ngreens, 4283 unsigned nblues 4284) 4285{ 4286 unsigned long rmask; /* was unsigned SPF 6/1/94 */ 4287 unsigned long gmask; /* was unsigned SPF 6/1/94 */ 4288 unsigned long bmask; /* was unsigned SPF 6/1/94 */ 4289 unsigned long *pixels; /* was unsigned SPF 6/1/94 */ 4290 Handle tuple; 4291 int s; 4292 4293 if (ncolors < 1) RaiseRange(taskData); 4294 4295 pixels = (unsigned long *) alloca(ncolors * sizeof(unsigned long)); 4296 4297 s = XAllocColorPlanes(d,cmap,contig,pixels,ncolors,nreds,ngreens,nblues,&rmask,&gmask,&bmask); 4298 4299 if (s == 0) RaiseXWindows (taskData, "XAllocColorPlanes failed"); 4300 4301 tuple = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 4302 4303#define data DEREFHANDLE(tuple) 4304 data->Set(0, DEREFWORD(CreateList4(taskData,ncolors,pixels,sizeof(unsigned long),CreateUnsignedLong))); 4305 data->Set(1, DEREFWORD(Make_arbitrary_precision(taskData, rmask))); 4306 data->Set(2, DEREFWORD(Make_arbitrary_precision(taskData, gmask))); 4307 data->Set(3, DEREFWORD(Make_arbitrary_precision(taskData, bmask))); 4308#undef data 4309 4310 return FINISHED(taskData, tuple); 4311} 4312 4313static Handle AllocNamedColor(TaskData *taskData, Display *d, Colormap cmap, PolyStringObject *string) 4314{ 4315 char name[500]; 4316 int s; 4317 XColor hardware; 4318 XColor database; 4319 4320 ClearXColor(&hardware); 4321 ClearXColor(&database); 4322 4323 Poly_string_to_C(string,name,sizeof(name)); 4324 4325 s = XAllocNamedColor(d,cmap,name,&hardware,&database); 4326 4327 if (s == 0) RaiseXWindows (taskData, "XAllocNamedColor failed"); 4328 4329 return CreatePair(taskData, CreateXColor(taskData, &hardware),CreateXColor(taskData, &database)); 4330} 4331 4332static Handle LookupColor(TaskData *taskData, Display *d, Colormap cmap, PolyStringObject *string) 4333{ 4334 char name[500]; 4335 int s; 4336 XColor hardware; 4337 XColor database; 4338 4339 ClearXColor(&hardware); 4340 ClearXColor(&database); 4341 4342 Poly_string_to_C(string,name,sizeof(name)); 4343 4344 s = XLookupColor(d,cmap,name,&database,&hardware); 4345 4346 if (s == 0) RaiseXWindows (taskData, "XLookupColor failed"); 4347 4348 return CreatePair(taskData, CreateXColor(taskData, &database),CreateXColor(taskData, &hardware)); 4349} 4350 4351static Handle ParseColor(TaskData *taskData, Display *d, Colormap cmap, PolyStringObject *string) 4352{ 4353 char name[500]; 4354 int s; 4355 XColor x; 4356 4357 ClearXColor(&x); 4358 4359 Poly_string_to_C(string,name,sizeof(name)); 4360 4361 s = XParseColor(d,cmap,name,&x); 4362 4363 if (s == 0) RaiseXWindows(taskData, "XParseColor failed"); 4364 4365 return CreateXColor(taskData, &x); 4366} 4367 4368static Handle QueryColor(TaskData *taskData, Display *d, Colormap cmap, unsigned pixel) 4369{ 4370 XColor x; 4371 4372 ClearXColor(&x); 4373 4374 x.pixel = pixel; 4375 4376 XQueryColor(d,cmap,&x); 4377 4378 return CreateXColor(taskData, &x); 4379} 4380 4381static void GetXPixel(TaskData *taskData, PolyWord p, void *v, unsigned) 4382{ 4383 XColor *X = (XColor *)v; 4384 ClearXColor(X); 4385 X->pixel = get_C_ulong(taskData, p); 4386} 4387 4388static Handle QueryColors(TaskData *taskData, Display *d, Colormap cmap, Handle list) 4389{ 4390 unsigned N = ListLength(DEREFWORD(list)); 4391 XColor *P = (XColor *) alloca(N * sizeof(XColor)); 4392 4393 GetList4(taskData, DEREFWORD(list),P,sizeof(XColor),GetXPixel); 4394 4395 XQueryColors(d,cmap,P,N); 4396 4397 return CreateList4(taskData,N,P,sizeof(XColor),CreateXColorF); 4398} 4399 4400static void StoreNamedColor 4401( 4402 Display *d, 4403 Colormap cmap, 4404 PolyStringObject *string, 4405 unsigned pixel, 4406 unsigned doRed, 4407 unsigned doGreen, 4408 unsigned doBlue 4409) 4410{ 4411 unsigned flags = (DoRed * doRed) | (DoGreen * doGreen) | (DoBlue * doBlue); 4412 4413 char name[500]; 4414 4415 Poly_string_to_C(string,name,sizeof(name)); 4416 4417 XStoreNamedColor(d,cmap,name,pixel,flags); 4418} 4419 4420static void StoreColors(TaskData *taskData, Display *d, Colormap cmap, Handle list) 4421{ 4422 unsigned N = ListLength(DEREFWORD(list)); 4423 XColor *P = (XColor *) alloca(N * sizeof(XColor)); 4424 4425 GetList4(taskData, DEREFWORD(list),P,sizeof(XColor),GetXColor); 4426 4427 XStoreColors(d,cmap,P,N); 4428} 4429 4430static void GetUnsigned(TaskData *taskData, PolyWord p, void *v, unsigned) 4431{ 4432 unsigned *u = (unsigned *)v; 4433 *u = get_C_ulong(taskData, p); 4434} 4435 4436static void GetUnsignedLong(TaskData *taskData, PolyWord p, void *v, unsigned) 4437{ 4438 unsigned long *u = (unsigned long *)v; 4439 *u = get_C_ulong(taskData, p); 4440} 4441 4442 4443static void FreeColors 4444( 4445 TaskData *taskData, 4446 Display *d, 4447 Colormap cmap, 4448 Handle list, 4449 unsigned planes 4450) 4451{ 4452 unsigned N = ListLength(DEREFWORD(list)); 4453 unsigned long *P = (unsigned long *) alloca(N * sizeof(unsigned long)); 4454 4455 GetList4(taskData,DEREFWORD(list),P,sizeof(unsigned long),GetUnsignedLong); 4456 4457 XFreeColors(d,cmap,P,N,planes); 4458} 4459 4460static Handle CreateColormap 4461( 4462 TaskData *taskData, 4463 void *p, 4464 Handle dsHandle /* handle to (X_Display_Object *) */ 4465) 4466{ 4467 return EmptyColormap(taskData, dsHandle,*(Colormap *)p); 4468} 4469 4470static Handle ListInstalledColormaps 4471( 4472 TaskData *taskData, 4473 Handle dsHandle, /* handle to (X_Display_Object *) */ 4474 Drawable drawable 4475) 4476{ 4477 int count; 4478 Colormap *cmaps; 4479 Handle list; 4480 4481 cmaps = XListInstalledColormaps(DEREFDISPLAYHANDLE(dsHandle)->display,drawable,&count); 4482 4483 if (cmaps == 0) RaiseXWindows(taskData, "XListInstalledColormaps failed"); 4484 4485 list = CreateList5(taskData,count,cmaps,sizeof(Colormap),CreateColormap,dsHandle); 4486 4487 XFree((char *)cmaps); 4488 4489 return list; 4490} 4491 4492 4493static Handle GetTimeOfDay(TaskData *taskData) 4494{ 4495 TimeVal now; 4496 4497 gettimeofday(&now, NULL); 4498 4499 return CreatePair(taskData, Make_arbitrary_precision(taskData, now.tv_sec),Make_arbitrary_precision(taskData, now.tv_usec)); 4500} 4501 4502static Handle GetState(TaskData *taskData, X_Window_Object *P) 4503{ 4504 assert(UNTAGGED(P->type) == X_Window); 4505 4506 CheckExists((X_Object *)P,window); 4507 4508 if (ISNIL(P->handler)) Crash ("No handler set"); 4509 4510 return CreatePair(taskData, SAVE(P->handler),SAVE(P->state)); 4511} 4512 4513static void SetState(X_Window_Object *W, PolyWord handler, PolyWord state) 4514{ 4515 if (! ResourceExists((X_Object *)W)) return; 4516 4517 assert(W->type == TAGGED(X_Window)); 4518 4519 if (NONNIL(handler)) 4520 { 4521 /* we are setting the handler and initial state */ 4522 /* so we need to remove all pending messages for */ 4523 /* this window since they will have the wrong type */ 4524 4525 PurgePendingWindowMessages(W); 4526 4527 W->handler = handler; 4528 W->state = state; 4529 4530 } 4531 else W->state = state; /* just update state */ 4532} 4533 4534/* Check if the first timer event has already expired. */ 4535static void CheckTimerQueue(void) 4536{ 4537 if (TList) 4538 { 4539 TimeVal now; 4540 gettimeofday(&now, NULL); 4541 TList->expired = TimeLeq(&TList->timeout,&now); 4542 } 4543} 4544 4545static void InsertTimeout 4546( 4547 TaskData *taskData, 4548 X_Window_Object *window_object, 4549 unsigned ms, 4550 PolyWord alpha, 4551 PolyWord handler 4552) 4553{ 4554 T_List **tail; 4555 T_List *newp; 4556 TimeVal now; 4557 4558 assert(window_object->type == TAGGED(X_Window)); 4559 CheckExists((X_Object *)window_object,window); 4560 4561 if (ISNIL(window_object->handler)) Crash ("No handler set"); 4562 4563 if (window_object->handler != handler) RaiseXWindows(taskData, "Handler mismatch"); 4564 4565 { /* find insertion point in list */ 4566 TimeVal dt; 4567 4568 gettimeofday(&now, NULL); 4569 dt.tv_sec = ms / 1000; 4570 dt.tv_usec = 1000 * (ms % 1000); 4571 4572 newp = (T_List *) malloc(sizeof(T_List)); 4573 TimeAdd(&now,&dt,&newp->timeout); 4574 4575 /* We use TimeLt here, not TimeLeq, because we 4576 want to add new messages AFTER existing ones. 4577 SPF 21/3/97 4578 */ 4579 for(tail = &TList; *tail; tail = &(*tail)->next) 4580 { 4581 if (TimeLt(&newp->timeout,&(*tail)->timeout)) break; 4582 } 4583 } 4584 4585 newp->next = *tail; 4586 newp->window_object = window_object; 4587 newp->widget_object = (X_Widget_Object *)0; 4588 newp->alpha = alpha.AsObjPtr(); 4589 newp->handler = handler.AsObjPtr(); 4590 newp->expired = 0; 4591 4592 *tail = newp; 4593} 4594 4595/* called when a widget is destroyed by Xt/Motif */ 4596static void DestroyWidgetCallback 4597( 4598 Widget widget, 4599 XtPointer client_data, 4600 XtPointer call_data 4601) 4602{ 4603 /* find the ML widget (if any) associated with the C widget */ 4604 X_Widget_Object *widget_object = FindWidget(widget); 4605 4606 if (widget_object != NULL) 4607 { 4608 /* Destroy the ML widget representations */ 4609 DestroyXObject((X_Object *)widget_object); 4610 /* Assume we can't get a C callback from a destroyed widget */ 4611 PurgeCCallbacks(widget_object,widget); 4612 } 4613 4614 debugReclaim(Widget,widget); 4615} 4616 4617#if 0 4618#define CheckRealized(Widget,Where)\ 4619{ \ 4620 if (XtIsRealized(Widget) == False) \ 4621 RaiseXWindows(taskData, #Where ": widget is not realized"); \ 4622} 4623 4624static Window WindowOfWidget(TaskData *taskData, Widget widget) 4625{ 4626 CheckRealized(widget,WindowOfWidget); 4627 return XtWindowOfObject(widget); 4628} 4629#endif 4630 4631/* Now returns NULL (None) for unrealized widgets SPF 1/2/94 */ 4632static Window WindowOfWidget(Widget widget) 4633{ 4634 return XtIsRealized(widget) ? XtWindowOfObject(widget) : None; 4635} 4636 4637 4638static void InsertWidgetTimeout 4639( 4640 TaskData *taskData, 4641 X_Widget_Object *widget_object, 4642 unsigned ms, 4643 PolyWord alpha, 4644 PolyWord handler 4645 ) 4646{ 4647 T_List **tail; 4648 T_List *newp; 4649 TimeVal now; 4650 4651 assert(widget_object->type == TAGGED(X_Widget)); 4652 CheckExists((X_Object *)widget_object,widget); 4653#if NEVER 4654 CheckRealized(GetWidget(taskData, (X_Object *)widget_object),InsertWidgetTimeout); 4655#endif 4656 4657 /* check that handler occurs in widget's callback list */ 4658 { 4659 PolyWord p = widget_object->callbackList; 4660 for(; NONNIL(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) 4661 { 4662 MLPair *q = (MLPair *)((ML_Cons_Cell*)p.AsObjPtr())->h.AsObjPtr(); 4663 if (SND(q) == handler) break; 4664 } 4665 if (ISNIL(p)) RaiseXWindows(taskData, "Handler mismatch"); 4666 } 4667 4668 4669 { 4670 TimeVal dt; 4671 4672 gettimeofday(&now, NULL); 4673 4674 dt.tv_sec = ms / 1000; 4675 dt.tv_usec = 1000 * (ms % 1000); 4676 4677 newp = (T_List *) malloc(sizeof(T_List)); 4678 4679 TimeAdd(&now,&dt,&newp->timeout); 4680 4681 /* We use TimeNegative here, not TimeExpired, because we 4682 want to add new messages AFTER existing ones. 4683 SPF 21/3/97 4684 */ 4685 for(tail = &TList; *tail; tail = &(*tail)->next) 4686 { 4687 if (TimeLt(&newp->timeout,&(*tail)->timeout)) break; 4688 } 4689 } 4690 4691 newp->next = *tail; 4692 newp->window_object = (X_Window_Object *)0; 4693 newp->widget_object = widget_object; 4694 newp->alpha = alpha.AsObjPtr(); 4695 newp->handler = handler.AsObjPtr(); 4696 newp->expired = 0; 4697 4698 *tail = newp; 4699} 4700 4701// Test whether input is available and block if it is not. 4702// N.B. There may be a GC while in here. 4703// This was previously in basicio.cpp but has been moved here 4704// since this is the only place it's used now. 4705static void process_may_block(TaskData *taskData, int fd) 4706{ 4707#ifdef __CYGWIN__ 4708 static struct timeval poll = {0,1}; 4709#else 4710 static struct timeval poll = {0,0}; 4711#endif 4712 fd_set read_fds; 4713 int selRes; 4714 4715 while (1) 4716 { 4717 4718 FD_ZERO(&read_fds); 4719 FD_SET(fd,&read_fds); 4720 4721 /* If there is something there we can return. */ 4722 selRes = select(FD_SETSIZE, &read_fds, NULL, NULL, &poll); 4723 if (selRes > 0) return; /* Something waiting. */ 4724 else if (selRes < 0 && errno != EINTR) // Maybe another thread closed descr 4725 raise_syscall(taskData, "select failed", errno); 4726 WaitInputFD waiter(fd); 4727 processes->ThreadPauseForIO(taskData, &waiter); 4728 } 4729} 4730 4731static Handle NextEvent(TaskData *taskData, Handle dsHandle /* handle to (X_Display_Object *) */) 4732{ 4733 for (;;) 4734 { 4735 /* Added here SPF 23/2/95 - check whether a timer event has expired */ 4736 CheckTimerQueue(); 4737 4738 if (TList && TList->expired) 4739 { 4740 T_List *next = TList->next; 4741 4742 EventHandle E = alloc_and_save(taskData, SIZEOF(ML_Event), F_MUTABLE_BIT); 4743 4744#define event ((ML_Event *)DEREFHANDLE(E)) 4745 event->type = DEREFWORD(Make_arbitrary_precision(taskData, 99)); 4746 event->sendEvent = DEREFWORD(Make_bool(True)); 4747 event->data = TList->alpha; 4748 4749 if (TList->window_object != 0) 4750 { 4751 assert(TList->widget_object == 0); 4752 4753 event->window = TList->window_object; 4754 event->callbacks = ListNull; 4755 event->events = ListNull; 4756 4757 assert(TList->window_object->handler == TList->handler); 4758 } 4759 else /* it is a Widget message */ 4760 { 4761 /* TList->widget_object etc. act like Roots */ 4762 assert(TList->widget_object != 0); 4763 4764 { 4765 Window w = WindowOfWidget(GetWidget(taskData, (X_Object *)TList->widget_object)); 4766 event->window = DEREFWINDOWHANDLE(EmptyWindow(taskData, GetDS(taskData, (X_Object *)TList->widget_object),w)); 4767 } 4768 4769 { /* create callback list - allocates storage */ 4770 Handle tailHandle = SAVE(ListNull); 4771 Handle widgetHandle = SAVE(TList->widget_object); 4772 Handle handlerHandle = SAVE(TList->handler); 4773 Handle pairHandle = CreatePair(taskData, widgetHandle,handlerHandle); 4774 4775 event->callbacks = DEREFLISTHANDLE(CreatePair(taskData, pairHandle,tailHandle)); 4776 event->events = ListNull; 4777 } 4778 } 4779#undef event 4780 4781 free(TList); 4782 4783 TList = next; 4784 4785 return FINISHED(taskData, E); 4786 } 4787 else /* ! (TList && TList->expired) */ if (DEREFDISPLAYHANDLE(dsHandle)->app_context == 0) 4788 /* use XNextEvent to get next event */ 4789 { 4790 Display *display = DEREFDISPLAYHANDLE(dsHandle)->display; 4791 int pending = XPending(display); 4792 4793 if (pending == 0) 4794 { 4795 process_may_block(taskData, display->fd); 4796 } 4797 else /* X Event arrived */ 4798 { 4799 XEvent ev; 4800 X_Window_Object *W; 4801 4802 XNextEvent(display,&ev); 4803 W = FindWindow(dsHandle,ev.xany.window); 4804 4805 if (W && NONNIL(W->handler)) 4806 { 4807 EventHandle E = CreateEvent(taskData, dsHandle,&ev,SAVE(W)); 4808 if (E) return E; 4809 } 4810 } 4811 } 4812 else /* use XtAppNextEvent to get next event */ 4813 { 4814 /* should use Xt to do time events as well */ 4815 int pending = XtAppPending(DEREFDISPLAYHANDLE(dsHandle)->app_context); 4816 4817 if (pending == 0) 4818 { 4819 process_may_block(taskData, DEREFDISPLAYHANDLE(dsHandle)->display->fd); 4820 } 4821 else 4822 { 4823 if ((pending & XtIMXEvent) == 0) /* not an X Event, probably an Xt timer event */ 4824 { 4825 assert(FList == TAGGED(0)); 4826 4827 callbacks_enabled = True; 4828 XtAppProcessEvent(DEREFDISPLAYHANDLE(dsHandle)->app_context,pending); 4829 callbacks_enabled = False; 4830 4831 if (FList != TAGGED(0)) 4832 { 4833 EventHandle E = alloc_and_save(taskData, SIZEOF(ML_Event), F_MUTABLE_BIT); 4834 4835#define event ((ML_Event *)DEREFHANDLE(E)) 4836 event->type = DEREFWORD(Make_arbitrary_precision(taskData, 100)); 4837 event->sendEvent = DEREFWORD(Make_bool(True)); 4838 event->window = TAGGED(0); 4839 event->data = TAGGED(0); 4840 event->callbacks = FList; /* FList != 0 */ 4841 event->events = GList; 4842#undef event 4843 FList = TAGGED(0); 4844 GList = TAGGED(0); 4845 return FINISHED(taskData, E); 4846 } 4847 } 4848 else /* Xt Event arrived */ 4849 { 4850 XEvent ev; 4851 int dispatched; 4852 4853 assert(FList == TAGGED(0)); 4854 4855 XtAppNextEvent(DEREFDISPLAYHANDLE(dsHandle)->app_context,&ev); 4856 4857 callbacks_enabled = True; 4858 dispatched = XtDispatchEvent(&ev); 4859 callbacks_enabled = False; 4860 4861 if (!dispatched) 4862 { 4863 X_Window_Object *W = FindWindow(dsHandle,ev.xany.window); 4864 4865 assert(FList == TAGGED(0) && GList == TAGGED(0)); 4866 4867 if (W && NONNIL(W->handler)) 4868 { 4869 EventHandle E = CreateEvent(taskData, dsHandle,&ev,SAVE(W)); 4870 if (E) return E; 4871 } 4872 } 4873 else if (! FList.IsTagged() || ! GList.IsTagged()) 4874 { 4875 EventHandle E = CreateEvent(taskData, dsHandle,&ev,EmptyWindow(taskData, dsHandle,ev.xany.window)); 4876 if (E) return E; 4877 } 4878 } 4879 } 4880 } 4881 } 4882} 4883 4884static Handle GetInputFocus(TaskData *taskData, Handle dsHandle /* handle to (X_Display_Object *) */) 4885{ 4886 Window focus; 4887 int revertTo; 4888 4889 XGetInputFocus(DEREFDISPLAYHANDLE(dsHandle)->display,&focus,&revertTo); 4890 4891 return CreatePair(taskData, EmptyWindow(taskData, dsHandle,focus),Make_arbitrary_precision(taskData, revertTo)); 4892} 4893 4894static void SetSelectionOwner 4895( 4896 Handle dsHandle, /* handle to (X_Display_Object *) */ 4897 unsigned selection, 4898 Window owner, 4899 unsigned time 4900) 4901{ 4902 Window old = XGetSelectionOwner(DEREFDISPLAYHANDLE(dsHandle)->display,selection); 4903 4904 if (old != owner) 4905 { 4906 /* SelectionClear is only sent by the server when the ownership of a */ 4907 /* selection passes from one client to another. We want every ML */ 4908 /* window to behave like a separate client, so when the ownership of */ 4909 /* a selection passes from one ML window to another we have to send */ 4910 /* the SelectionClear ourselves. */ 4911 4912 X_Window_Object *W = FindWindow(dsHandle,old); 4913 4914 if (W && NONNIL(W->handler)) /* this clients window */ 4915 { 4916 XEvent event; /* was XSelectionClearEvent SPF 6/1/94 */ 4917 4918 event.xselectionclear.type = SelectionClear; 4919 event.xselectionclear.serial = 0; 4920 event.xselectionclear.send_event = True; 4921 event.xselectionclear.display = DEREFDISPLAYHANDLE(dsHandle)->display; 4922 event.xselectionclear.window = old; 4923 event.xselectionclear.selection = selection; 4924 event.xselectionclear.time = time; 4925 4926 XSendEvent(DEREFDISPLAYHANDLE(dsHandle)->display,old,True,0,&event); 4927 } 4928 } 4929 4930 XSetSelectionOwner(DEREFDISPLAYHANDLE(dsHandle)->display,selection,owner,time); 4931} 4932 4933static void SendSelectionNotify 4934( 4935 Display *d, 4936 unsigned selection, 4937 unsigned target, 4938 unsigned property, 4939 Window requestor, 4940 unsigned time 4941) 4942{ 4943 XEvent event; /* was XSelectionEvent SPF 6/1/94 */ 4944 4945 event.xselection.type = SelectionNotify; 4946 event.xselection.serial = 0; 4947 event.xselection.send_event = True; 4948 event.xselection.display = d; 4949 event.xselection.requestor = requestor; 4950 event.xselection.selection = selection; 4951 event.xselection.target = target; 4952 event.xselection.property = property; 4953 event.xselection.time = time; 4954 4955 XSendEvent(d,requestor,True,0,&event); 4956} 4957 4958static Handle InternAtom 4959( 4960 TaskData *taskData, 4961 Display *d, 4962 PolyStringObject *string, 4963 Bool only_if_exists 4964) 4965{ 4966 char name[500]; 4967 4968 Poly_string_to_C(string,name,sizeof(name)); 4969 4970 return Make_arbitrary_precision(taskData, XInternAtom(d,name,only_if_exists)); 4971} 4972 4973static Handle GetAtomName(TaskData *taskData, Display *d, unsigned atom) 4974{ 4975 Handle s; 4976 4977 char *name = XGetAtomName(d,atom); 4978 4979 if (name == NULL) RaiseXWindows(taskData, "XGetAtomName failed"); 4980 4981 s = Make_string(name); 4982 4983 XFree((char *)name); 4984 4985 return s; 4986} 4987 4988/* The order of these depends on the XCharStruct datatype */ 4989typedef struct 4990{ 4991 PolyWord width; /* ML int */ 4992 PolyWord ascent; /* ML int */ 4993 PolyWord descent; /* ML int */ 4994 PolyWord lbearing; /* ML int */ 4995 PolyWord rbearing; /* ML int */ 4996 PolyWord attributes; /* ML int */ 4997} MLXCharStruct; 4998 4999static Handle CreateCharStruct(TaskData *taskData, void *v) 5000{ 5001 XCharStruct *cs = (XCharStruct *)v; 5002 Handle dataHandle = alloc_and_save(taskData, SIZEOF(MLXCharStruct), F_MUTABLE_BIT); 5003 5004#define data ((MLXCharStruct *)DEREFHANDLE(dataHandle)) 5005 data->width = DEREFWORD(Make_int(cs->width)); 5006 data->ascent = DEREFWORD(Make_int(cs->ascent)); 5007 data->descent = DEREFWORD(Make_int(cs->descent)); 5008 data->lbearing = DEREFWORD(Make_int(cs->lbearing)); 5009 data->rbearing = DEREFWORD(Make_int(cs->rbearing)); 5010 data->attributes = DEREFWORD(Make_arbitrary_precision(taskData, cs->attributes)); 5011#undef data 5012 5013 return FINISHED(taskData, dataHandle); 5014} 5015 5016/* The order of these depends on the XFontStruct datatype */ 5017typedef struct 5018{ 5019 X_Font_Object *font_object; 5020 PolyWord ascent; /* ML int */ 5021 PolyWord descent; /* ML int */ 5022 PolyWord maxChar; /* ML int */ 5023 PolyWord minChar; /* ML int */ 5024 PolyWord perChar; /* ML XCharStruct list */ 5025 PolyWord maxByte1; /* ML int */ 5026 PolyWord minByte1; /* ML int */ 5027 PolyWord direction; /* (short ML int) FontLeftToRight | FontRightToLeft */ 5028 MLXCharStruct *maxBounds; 5029 MLXCharStruct *minBounds; 5030 PolyWord defaultChar; /* ML int */ 5031 PolyWord allCharsExist; /* ML bool */ 5032} MLXFontStruct; 5033 5034static Handle CreateFontStruct 5035( 5036 TaskData *taskData, 5037 void *v, 5038 Handle dsHandle /* Handle to (X_Display_Object *) */ 5039) 5040{ 5041 XFontStruct *fs = (XFontStruct *)v; 5042 Handle dataHandle = alloc_and_save(taskData, SIZEOF(MLXFontStruct), F_MUTABLE_BIT); 5043 5044 int n = fs->max_char_or_byte2 - fs->min_char_or_byte2 + 1; 5045 5046 if (fs->per_char == 0) n = 0; 5047 5048#define data ((MLXFontStruct *)DEREFHANDLE(dataHandle)) 5049 data->font_object = (X_Font_Object *)DEREFHANDLE(EmptyFont(taskData, dsHandle,fs->fid,fs)); 5050 data->ascent = DEREFWORD(Make_int(fs->ascent)); 5051 data->descent = DEREFWORD(Make_int(fs->descent)); 5052 data->maxChar = DEREFWORD(Make_arbitrary_precision(taskData, fs->max_char_or_byte2)); 5053 data->minChar = DEREFWORD(Make_arbitrary_precision(taskData, fs->min_char_or_byte2)); 5054 data->perChar = DEREFHANDLE(CreateList4(taskData,n,fs->per_char,sizeof(XCharStruct),CreateCharStruct)); 5055 data->maxByte1 = DEREFWORD(Make_arbitrary_precision(taskData, fs->max_byte1)); 5056 data->minByte1 = DEREFWORD(Make_arbitrary_precision(taskData, fs->min_byte1)); 5057 data->direction = DEREFWORD(Make_arbitrary_precision(taskData, (fs->direction == FontLeftToRight) ? 1 : 2)); 5058 data->maxBounds = (MLXCharStruct *)DEREFHANDLE(CreateCharStruct(taskData, &fs->max_bounds)); 5059 data->minBounds = (MLXCharStruct *)DEREFHANDLE(CreateCharStruct(taskData, &fs->min_bounds)); 5060 data->defaultChar = DEREFWORD(Make_arbitrary_precision(taskData, fs->default_char)); 5061 data->allCharsExist = DEREFWORD(Make_bool(fs->all_chars_exist)); 5062#undef data 5063 5064 return FINISHED(taskData, dataHandle); 5065} 5066 5067static XFontStruct *GetFS(TaskData *taskData, X_Font_Object *P) 5068{ 5069 5070 assert(UNTAGGED(P->type) == X_Font); 5071 5072 if (*(P->fs) == NULL) RaiseXWindows(taskData, "Not a real XFontStruct"); 5073 5074 CheckExists((X_Object *)P,font); 5075 5076 return *(P->fs); 5077} 5078 5079static XFontStruct *GetFontStruct(TaskData *taskData,PolyWord p) 5080{ 5081 MLXFontStruct *P = (MLXFontStruct *)p.AsObjPtr(); 5082 return GetFS(taskData,P->font_object); 5083} 5084 5085static Handle CreateString(TaskData *taskData, void *s) 5086{ 5087 return Make_string(*(char **)s); 5088} 5089 5090static Handle GetFontPath(TaskData *taskData, Display *d) 5091{ 5092 Handle list; 5093 char **names; 5094 int count; 5095 5096 names = XGetFontPath(d,&count); 5097 5098 if (names == 0) RaiseXWindows(taskData, "XGetFontPath failed"); 5099 5100 list = CreateList4(taskData,count,names,sizeof(char *),CreateString); 5101 5102 XFreeFontNames(names); 5103 5104 return list; 5105} 5106 5107static void FreeStrings(char **s, int n) 5108{ 5109 while(n--) free(*s++); 5110 return; 5111} 5112 5113static void SetFontPath(TaskData *taskData, Display *d, Handle list) 5114{ 5115 if (NONNIL(DEREFWORD(list))) 5116 { 5117 unsigned N = ListLength(DEREFWORD(list)); 5118 char **D = (char **) alloca(N * sizeof(char *)); 5119 5120 GetList4(taskData, DEREFWORD(list),D,sizeof(char *),CopyString); 5121 5122 XSetFontPath(d,D,N); 5123 5124 FreeStrings(D,N); 5125 } 5126 return; 5127} 5128 5129static Handle ListFonts(TaskData *taskData,Display *d, PolyStringObject *string, unsigned maxnames) 5130{ 5131 char name[500]; 5132 Handle list; 5133 char **names; 5134 int count; 5135 5136 Poly_string_to_C(string,name,sizeof(name)); 5137 5138 names = XListFonts(d,name,maxnames,&count); 5139 5140 if (names == 0) RaiseXWindows(taskData, "XListFonts failed"); 5141 5142 list = CreateList4(taskData,count,names,sizeof(char *),CreateString); 5143 5144 XFreeFontNames(names); 5145 5146 return list; 5147} 5148 5149static Handle ListFontsWithInfo 5150( 5151 TaskData *taskData, 5152 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5153 PolyStringObject *string, 5154 unsigned maxnames 5155) 5156{ 5157 char name[500]; 5158 char **names; 5159 int count; 5160 XFontStruct *info; 5161 Handle pair; 5162 5163 Poly_string_to_C(string,name,sizeof(name)); 5164 5165 names = XListFontsWithInfo(DEREFDISPLAYHANDLE(dsHandle)->display,name,maxnames,&count,&info); 5166 5167 if (names == 0) RaiseXWindows(taskData, "XListFontsWithInfo failed"); 5168 5169 pair = CreatePair(taskData, CreateList4(taskData,count,names,sizeof(char *),CreateString), 5170 CreateList5(taskData,count,info,sizeof(XFontStruct),CreateFontStruct,dsHandle)); 5171 5172 XFree((char *)info); 5173 XFreeFontNames(names); 5174 5175 return pair; 5176} 5177 5178static Handle LoadFont 5179( 5180 TaskData *taskData, 5181 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5182 PolyStringObject *string 5183) 5184{ 5185 char name[500]; Font font; 5186 5187 Poly_string_to_C(string,name,sizeof(name)); 5188 5189 font = XLoadFont(DEREFDISPLAYHANDLE(dsHandle)->display,name); 5190 5191 if (font == 0) RaiseXWindows(taskData, "XLoadFont failed"); 5192 5193 return EmptyFont(taskData, dsHandle,font,(XFontStruct *)NULL); 5194} 5195 5196static Handle LoadQueryFont 5197( 5198 TaskData *taskData, 5199 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5200 PolyStringObject *string 5201) 5202{ 5203 char name[500]; XFontStruct *fs; 5204 5205 Poly_string_to_C(string,name,sizeof(name)); 5206 5207 fs = XLoadQueryFont(DEREFDISPLAYHANDLE(dsHandle)->display,name); 5208 5209 if (fs == 0) RaiseXWindows(taskData, "XLoadQueryFont failed"); 5210 5211 return CreateFontStruct(taskData,fs,dsHandle); 5212} 5213 5214static Handle QueryFont 5215( 5216 TaskData *taskData, 5217 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5218 Font font 5219) 5220{ 5221 XFontStruct *fs; 5222 5223 fs = XQueryFont(DEREFDISPLAYHANDLE(dsHandle)->display,font); 5224 5225 if (fs == 0) RaiseXWindows(taskData, "XQueryFont failed"); 5226 5227 return CreateFontStruct(taskData,fs,dsHandle); 5228} 5229 5230static Handle TextExtents(TaskData *taskData, XFontStruct *fs, PolyStringObject *s) 5231{ 5232 Handle dataHandle = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 5233 5234 int direction,ascent,descent; XCharStruct overall; 5235 5236 XTextExtents(fs,s->chars,s->length,&direction,&ascent,&descent,&overall); 5237 5238#define data DEREFHANDLE(dataHandle) 5239 data->Set(0, DEREFWORD(Make_arbitrary_precision(taskData, (direction == FontLeftToRight) ? 1 : 2))); 5240 data->Set(1, DEREFWORD(Make_int(ascent))); 5241 data->Set(2, DEREFWORD(Make_int(descent))); 5242 data->Set(3, DEREFWORD(CreateCharStruct(taskData, &overall))); 5243#undef data 5244 5245 return FINISHED(taskData, dataHandle); 5246} 5247 5248static Handle TextExtents16(TaskData *taskData, XFontStruct *fs, Handle list) 5249{ 5250 Handle dataHandle = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 5251 5252 int direction,ascent,descent; XCharStruct overall; 5253 5254 unsigned N = ListLength(DEREFWORD(list)); 5255 XChar2b *L = (XChar2b *) alloca(N * sizeof(XChar2b)); 5256 5257 GetList4(taskData,DEREFWORD(list),L,sizeof(XChar2b),GetChar2); 5258 5259 XTextExtents16(fs,L,N,&direction,&ascent,&descent,&overall); 5260 5261#define data DEREFHANDLE(dataHandle) 5262 data->Set(0, DEREFWORD(Make_arbitrary_precision(taskData, (direction == FontLeftToRight) ? 1 : 2))); 5263 data->Set(1, DEREFWORD(Make_int(ascent))); 5264 data->Set(2, DEREFWORD(Make_int(descent))); 5265 data->Set(3, DEREFWORD(CreateCharStruct(taskData, &overall))); 5266#undef data 5267 5268 return FINISHED(taskData, dataHandle); 5269} 5270 5271static Handle TextWidth(TaskData *taskData, XFontStruct *fs, PolyStringObject *s) 5272{ 5273 if (fs->per_char == 0) return Make_int(s->length * fs->max_bounds.width); 5274 5275 return Make_int(XTextWidth(fs,s->chars,s->length)); 5276} 5277 5278static Handle TextWidth16(TaskData *taskData, XFontStruct *fs, Handle list) 5279{ 5280 unsigned N = ListLength(DEREFWORD(list)); 5281 XChar2b *L = (XChar2b *) alloca(N * sizeof(XChar2b)); 5282 5283 GetList4(taskData, DEREFWORD(list),L,sizeof(XChar2b),GetChar2); 5284 5285 return Make_int(XTextWidth16(fs,L,N)); 5286} 5287 5288static Handle GetTextProperty(TaskData *taskData, Display *d, Window w, unsigned property) 5289{ 5290 XTextProperty T; 5291 Handle tuple; 5292 5293 int s = XGetTextProperty(d,w,&T,property); 5294 5295 if (s == 0) RaiseXWindows(taskData, "XGetTextProperty failed"); 5296 5297 tuple = alloc_and_save(taskData, 4, F_MUTABLE_BIT); 5298 5299#define data DEREFHANDLE(tuple) 5300 data->Set(0, C_string_to_Poly(taskData, (char *)T.value,T.nitems * T.format / 8)); 5301 data->Set(1, DEREFWORD(Make_arbitrary_precision(taskData, T.encoding))); 5302 data->Set(2, DEREFWORD(Make_int(T.format))); 5303 data->Set(3, DEREFWORD(Make_arbitrary_precision(taskData, T.nitems))); 5304#undef data 5305 5306 return FINISHED(taskData, tuple); 5307} 5308 5309static void GetXWMHints(TaskData *taskData, PolyWord p, void *v, unsigned) 5310{ 5311 PolyObject *P = p.AsObjPtr(); 5312 XWMHints *H = (XWMHints *)v; 5313 H->input = get_C_ulong(taskData, P->Get(0)); 5314 H->initial_state = get_C_ulong(taskData, P->Get(1)); 5315 H->icon_pixmap = GetPixmap(taskData, (X_Object *)P->Get(2).AsObjPtr()); 5316 H->icon_window = GetWindow(taskData, (X_Object *)P->Get(3).AsObjPtr()); 5317 H->icon_x = GetPointX(taskData, P->Get(4)); 5318 H->icon_y = GetPointY(taskData, P->Get(4)); 5319 H->icon_mask = GetPixmap(taskData, (X_Object *)P->Get(5).AsObjPtr()); 5320 H->flags = get_C_ulong(taskData, P->Get(6)); 5321 H->window_group = 0; 5322} 5323 5324 5325 5326typedef struct 5327{ 5328 PolyWord x0; 5329 PolyWord x1; 5330 PolyWord x2; 5331 PolyWord x3; 5332 PolyWord x4; 5333 PolyWord x5; /* pair of points */ 5334 PolyWord x6; 5335 PolyWord x7; 5336 PolyWord x8; 5337} MLXWMSizeHintsTuple; 5338 5339static void GetXWMSizeHints(TaskData *taskData, PolyWord p, void *v, unsigned) 5340{ 5341 MLXWMSizeHintsTuple *P = (MLXWMSizeHintsTuple *)p.AsObjPtr(); 5342 XSizeHints *H = (XSizeHints *)v; 5343 CheckZeroRect(taskData, P->x1); 5344 CheckZeroRect(taskData, P->x2); 5345 CheckZeroRect(taskData, P->x3); 5346 CheckZeroRect(taskData, P->x4); 5347 CheckZeroRect(taskData, P->x6); 5348 5349 H->x = GetPointX(taskData, P->x0); 5350 H->y = GetPointY(taskData, P->x0); 5351 H->width = GetRectW(taskData, P->x1); 5352 H->height = GetRectH(taskData, P->x1); 5353 H->min_width = GetRectW(taskData, P->x2); 5354 H->min_height = GetRectH(taskData, P->x2); 5355 H->max_width = GetRectW(taskData, P->x3); 5356 H->max_height = GetRectH(taskData, P->x3); 5357 H->width_inc = GetRectW(taskData, P->x4); 5358 H->height_inc = GetRectH(taskData, P->x4); 5359 H->min_aspect.x = GetPointX(taskData, FST(P->x5)); 5360 H->min_aspect.y = GetPointY(taskData, FST(P->x5)); 5361 H->max_aspect.x = GetPointX(taskData, SND(P->x5)); 5362 H->max_aspect.y = GetPointY(taskData, SND(P->x5)); 5363 H->base_width = GetRectW(taskData, P->x6); 5364 H->base_height = GetRectH(taskData, P->x6); 5365 H->win_gravity = get_C_ulong(taskData, P -> x7); 5366 H->flags = get_C_ulong(taskData, P -> x8); 5367} 5368 5369static void GetIconSize(TaskData *taskData, PolyWord p, void *v, unsigned) 5370{ 5371 MLTriple *P = (MLTriple *)p.AsObjPtr(); 5372 XIconSize *s = (XIconSize *)v; 5373 CheckZeroRect(taskData, FST(P)); 5374 CheckZeroRect(taskData, SND(P)); 5375 CheckZeroRect(taskData, THIRD(P)); 5376 5377 s->min_width = GetRectW(taskData, FST(P)); 5378 s->min_height = GetRectH(taskData, FST(P)); 5379 s->max_width = GetRectW(taskData, SND(P)); 5380 s->max_height = GetRectH(taskData, SND(P)); 5381 s->width_inc = GetRectW(taskData, THIRD(P)); 5382 s->height_inc = GetRectH(taskData, THIRD(P)); 5383} 5384 5385static void GetSigned(TaskData *taskData, PolyWord p, void *i, unsigned) 5386{ 5387 *(int*)i = get_C_long(taskData, p); 5388} 5389 5390static void GetPixmaps(TaskData *taskData, PolyWord pp, void *m, unsigned) 5391{ 5392 X_Object *p = (X_Object *)pp.AsObjPtr(); 5393 *(Pixmap *)m = GetPixmap(taskData, p); 5394} 5395 5396static void GetColormaps(TaskData *taskData, PolyWord pp, void *v, unsigned) 5397{ 5398 X_Object *p = (X_Object *)pp.AsObjPtr(); 5399 *(Colormap *)v = GetColormap(taskData, p); 5400} 5401 5402static void GetCursors(TaskData *taskData, PolyWord pp, void *c, unsigned) 5403{ 5404 X_Object *p = (X_Object *)pp.AsObjPtr(); 5405 *(Cursor *)c = GetCursor(taskData, p); 5406} 5407 5408static void GetDrawables(TaskData *taskData, PolyWord pp, void *d, unsigned) 5409{ 5410 X_Object *p = (X_Object *)pp.AsObjPtr(); 5411 *(Drawable *)d = GetDrawable(taskData, p); 5412} 5413 5414static void GetFonts(TaskData *taskData, PolyWord pp, void *f, unsigned) 5415{ 5416 X_Object *p = (X_Object *)pp.AsObjPtr(); 5417 *(Font *)f = GetFont(taskData, p); 5418} 5419 5420static void GetVisualIds(TaskData *taskData, PolyWord pp, void *u, unsigned) 5421{ 5422 X_Object *p = (X_Object *)pp.AsObjPtr(); 5423 *(unsigned *)u = GetVisual(taskData, p)->visualid; 5424} 5425 5426static void SetProperty 5427( 5428 TaskData *taskData, 5429 Display *d, 5430 Window w, 5431 unsigned property, 5432 unsigned target, 5433 Handle list, 5434 unsigned encoding 5435) 5436{ 5437 unsigned format; 5438 unsigned bytes; 5439 uchar *value; 5440 5441 /* SPF 7/7/94 - XA_STRING pulled out as special case; this enables */ 5442 /* gcc to understand the previously data-dependant control flow. */ 5443 if (encoding == XA_STRING) 5444 { 5445 PolyStringObject *s = GetString (DEREFHANDLE(list)); 5446 5447 format = 8; 5448 bytes = s->length; 5449 value = (uchar *) s->chars; 5450 } 5451 5452 else 5453 { 5454 unsigned length = ListLength(DEREFWORD(list)); 5455 unsigned size; 5456 GetFunc get; 5457 5458 switch(encoding) 5459 { 5460 case XA_ATOM: size = sizeof(unsigned); get = GetUnsigned; format = 32; break; 5461 case XA_BITMAP: size = sizeof(Pixmap); get = GetPixmaps; format = 32; break; 5462 case XA_COLORMAP: size = sizeof(Colormap); get = GetColormaps; format = 32; break; 5463 case XA_CURSOR: size = sizeof(Cursor); get = GetCursors; format = 32; break; 5464 case XA_DRAWABLE: size = sizeof(Drawable); get = GetDrawables; format = 32; break; 5465 case XA_FONT: size = sizeof(Font); get = GetFonts; format = 32; break; 5466 case XA_PIXMAP: size = sizeof(Pixmap); get = GetPixmaps; format = 32; break; 5467 case XA_VISUALID: size = sizeof(unsigned); get = GetVisualIds; format = 32; break; 5468 case XA_CARDINAL: size = sizeof(unsigned); get = GetUnsigned; format = 32; break; 5469 case XA_INTEGER: size = sizeof(int); get = GetSigned; format = 32; break; 5470 case XA_WINDOW: size = sizeof(Window); get = GetWindows; format = 32; break; 5471 case XA_ARC: size = sizeof(XArc); get = GetArcs; format = 16; break; 5472 case XA_POINT: size = sizeof(XPoint); get = GetPoints; format = 16; break; 5473 case XA_RECTANGLE: size = sizeof(XRectangle); get = GetRects; format = 16; break; 5474 case XA_RGB_COLOR_MAP: size = sizeof(XStandardColormap); get = GetStandardColormap; format = 32; break; 5475 case XA_WM_HINTS: size = sizeof(XWMHints); get = GetXWMHints; format = 32; break; 5476 case XA_WM_SIZE_HINTS: size = sizeof(XSizeHints); get = GetXWMSizeHints; format = 32; break; 5477 case XA_WM_ICON_SIZE: size = sizeof(XIconSize); get = GetIconSize; format = 32; break; 5478 default: Crash ("Bad property type %x",encoding); /*NOTREACHED*/ 5479 } 5480 5481 bytes = length * size; 5482 value = (uchar *) alloca(bytes); 5483 GetList4(taskData, DEREFWORD(list),value,(int)size,get); 5484 } 5485 5486 { 5487 XTextProperty T; 5488 5489 T.value = value; 5490 T.encoding = target; 5491 T.format = format; 5492 T.nitems = (bytes * 8) / format; 5493 5494 XSetTextProperty(d,w,&T,property); 5495 } 5496} 5497 5498static Handle GetWMHints 5499( 5500 TaskData *taskData, 5501 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5502 Window w 5503) 5504{ 5505 Handle tuple = alloc_and_save(taskData, 7, F_MUTABLE_BIT); 5506 5507 XWMHints *H = XGetWMHints(DEREFDISPLAYHANDLE(dsHandle)->display,w); 5508 5509 if (H) 5510 { 5511 5512#define data DEREFHANDLE(tuple) 5513 data->Set(0, DEREFWORD(Make_arbitrary_precision(taskData, H->input))); 5514 data->Set(1, DEREFWORD(Make_arbitrary_precision(taskData, H->initial_state))); 5515 data->Set(2, DEREFWORD(EmptyPixmap(taskData, dsHandle,H->icon_pixmap))); 5516 data->Set(3, DEREFWORD(EmptyWindow(taskData, dsHandle,H->icon_window))); 5517 data->Set(4, DEREFWORD(CreatePoint(taskData, H->icon_x,H->icon_y))); 5518 data->Set(5, DEREFWORD(EmptyPixmap(taskData, dsHandle,H->icon_mask))); 5519 data->Set(6, DEREFWORD(Make_arbitrary_precision(taskData, H->flags))); 5520#undef data 5521 5522 XFree((char *)H); 5523 } 5524 5525 /* else what (?) */ 5526 5527 return FINISHED(taskData, tuple); 5528} 5529 5530static Handle GetWMSizeHints 5531( 5532 TaskData *taskData, 5533 Display *d, 5534 Window w, 5535 unsigned property 5536) 5537{ 5538 XSizeHints H; 5539 long supplied; /* was unsigned SPF 6/1/94 */ 5540 5541 Handle tuple = alloc_and_save(taskData, 9, F_MUTABLE_BIT); 5542 5543 int s = XGetWMSizeHints(d,w,&H,&supplied,property); 5544 5545 if (s) 5546 { 5547 Handle p1 = CreatePoint(taskData, H.min_aspect.x,H.min_aspect.y); 5548 Handle p2 = CreatePoint(taskData, H.max_aspect.x,H.max_aspect.y); 5549 5550#define data DEREFHANDLE(tuple) 5551 data->Set(0, DEREFWORD(CreatePoint(taskData, H.x,H.y))); 5552 data->Set(1, DEREFWORD(CreateArea(H.width,H.height))); 5553 data->Set(2, DEREFWORD(CreateArea(H.min_width,H.min_height))); 5554 data->Set(3, DEREFWORD(CreateArea(H.max_width,H.max_height))); 5555 data->Set(4, DEREFWORD(CreateArea(H.width_inc,H.height_inc))); 5556 data->Set(5, DEREFWORD(CreatePair(taskData, p1,p2))); 5557 data->Set(6, DEREFWORD(CreateArea(H.base_width,H.base_height))); 5558 data->Set(7, DEREFWORD(Make_arbitrary_precision(taskData, H.win_gravity))); 5559 data->Set(8, DEREFWORD(Make_arbitrary_precision(taskData, H.flags))); 5560#undef data 5561 } 5562 5563 /* else (?) */ 5564 5565 return FINISHED(taskData, tuple); 5566} 5567 5568#if 0 5569typedef struct 5570{ 5571MLPair *x0; /* pair of points */ 5572MLXRectangle *x1; 5573PolyWord x2; /* ML int */ 5574} MLWMGeometryTriple; 5575#endif 5576 5577static Handle WMGeometry 5578( 5579 TaskData *taskData, 5580 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5581 PolyStringObject *user, 5582 PolyStringObject *def, 5583 unsigned borderWidth, 5584 PolyWord P 5585) 5586{ 5587 XSizeHints H; int x,y,width,height,gravity,mask; 5588 5589 char userGeometry[500],defaultGeometry[500]; 5590 5591 GetXWMSizeHints(taskData, P, &H, 0); 5592 5593 Poly_string_to_C(user,userGeometry ,sizeof(userGeometry)); 5594 Poly_string_to_C(def ,defaultGeometry,sizeof(defaultGeometry)); 5595 5596 mask = XWMGeometry(DEREFDISPLAYHANDLE(dsHandle)->display, 5597 DEREFDISPLAYHANDLE(dsHandle)->screen, 5598 userGeometry, 5599 defaultGeometry, 5600 borderWidth, 5601 &H,&x,&y,&width,&height,&gravity); 5602 5603 return CreateTriple(taskData, CreatePoint(taskData, x,y),CreateArea(width,height),Make_arbitrary_precision(taskData, gravity)); 5604} 5605 5606static Handle CreateIconSize(TaskData *taskData, void *v) 5607{ 5608 XIconSize *s = (XIconSize *)v; 5609 return CreateTriple(taskData, CreateArea(s->min_width,s->min_height), 5610 CreateArea(s->max_width,s->max_height), 5611 CreateArea(s->width_inc,s->height_inc)); 5612} 5613 5614static Handle GetIconSizes(TaskData *taskData, Display *d, Window w) 5615{ 5616 XIconSize *sizes; 5617 int count; 5618 5619 int s = XGetIconSizes(d,w,&sizes,&count); 5620 5621 if (s) 5622 { 5623 Handle list = CreateList4(taskData,count,sizes,sizeof(XIconSize),CreateIconSize); 5624 5625 XFree((char *)sizes); 5626 5627 return list; 5628 } 5629 5630 return SAVE(ListNull); 5631} 5632 5633static Handle GetTransientForHint 5634( 5635 TaskData *taskData, 5636 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5637 Window w 5638) 5639{ 5640 Window p; 5641 5642 int s = XGetTransientForHint(DEREFDISPLAYHANDLE(dsHandle)->display,w,&p); 5643 5644 if (s == 0) RaiseXWindows(taskData, "XGetTransientForHint failed"); 5645 5646 return EmptyWindow(taskData, dsHandle,p); 5647} 5648 5649static Handle GetWMColormapWindows 5650( 5651 TaskData *taskData, 5652 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5653 Window parent 5654) 5655{ 5656 Window *windows; 5657 int count; 5658 5659 int s = XGetWMColormapWindows(DEREFDISPLAYHANDLE(dsHandle)->display,parent,&windows,&count); 5660 5661 if (s) 5662 { 5663 Handle list = CreateList5(taskData,count,windows,sizeof(Window),CreateDrawable,dsHandle); 5664 5665 XFree((char *)windows); 5666 5667 return list; 5668 } 5669 5670 return SAVE(ListNull); 5671} 5672 5673 5674static Handle GetRGBColormaps 5675( 5676 TaskData *taskData, 5677 Handle dsHandle, /* Handle to (X_Display_Object *) */ 5678 Window w, 5679 unsigned property 5680) 5681{ 5682 XStandardColormap *maps; 5683 int count; 5684 5685 int s = XGetRGBColormaps(DEREFDISPLAYHANDLE(dsHandle)->display,w,&maps,&count,property); 5686 5687 if (s) 5688 { 5689 Handle list = CreateList5(taskData,count,maps,sizeof(XStandardColormap),CreateStandardColormap,dsHandle); 5690 5691 XFree((char *)maps); 5692 5693 return list; 5694 } 5695 5696 return SAVE(ListNull); 5697} 5698 5699static Handle GetID(TaskData *taskData, X_Object *P) 5700{ 5701 switch(UNTAGGED(P->type)) 5702 { 5703 case X_GC: return Make_arbitrary_precision(taskData, GetGC(taskData, P)->gid); /* GCID */ 5704 case X_Font: return Make_arbitrary_precision(taskData, GetFont(taskData, P)); /* FontID */ 5705 case X_Cursor: return Make_arbitrary_precision(taskData, GetCursor(taskData, P)); /* CursorId */ 5706 case X_Window: return Make_arbitrary_precision(taskData, GetWindow(taskData, P)); /* DrawableID */ 5707 case X_Pixmap: return Make_arbitrary_precision(taskData, GetPixmap(taskData, P)); /* DrawableID */ 5708 case X_Colormap: return Make_arbitrary_precision(taskData, GetColormap(taskData, P)); /* ColormapID */ 5709 case X_Visual: return Make_arbitrary_precision(taskData, GetVisual(taskData, P)->visualid); /* VisualID */ 5710 case X_Widget: return Make_arbitrary_precision(taskData, (unsigned long)GetNWidget(taskData, P)); /* Widget -- SAFE(?) */ 5711 default: Crash ("Bad X_Object type (%d) in GetID",UNTAGGED(P->type)) /*NOTREACHED*/; 5712 } 5713} 5714 5715static Handle OpenDisplay(TaskData *taskData, PolyStringObject *string) 5716{ 5717 char name[500]; 5718 Display *display; 5719 Handle dsHandle /* Handle to (X_Display_Object *) */; 5720 5721 Poly_string_to_C(string,name,sizeof(name)); 5722 5723 display = XOpenDisplay(name); 5724 5725 if (display == 0) RaiseXWindows(taskData, "XOpenDisplay failed"); 5726 5727 /* I don't think this is needed. DCJM 26/5/2000. */ 5728 /* add_file_descr(display->fd); */ 5729 5730 dsHandle = alloc_and_save(taskData, SIZEOF(X_Display_Object), F_MUTABLE_BIT|F_BYTE_OBJ); 5731 5732 debug1 ("%s display opened\n",DisplayString(display)); 5733 5734 debug1 ("%x display fd\n",display->fd); 5735 5736#define ds DEREFDISPLAYHANDLE(dsHandle) 5737 /* Ok to store C values because this is a byte object */ 5738 ds->type = TAGGED(X_Display); 5739 ds->display = display; 5740 ds->screen = DefaultScreen(display); 5741 ds->app_context = 0; 5742#undef ds 5743 5744 return AddXObject(FINISHED(taskData, dsHandle)); 5745} 5746 5747/* indirection removed SPF 11/11/93 */ 5748static XmFontList GetXmFontList(PolyWord p /* NOT a handle */) 5749{ 5750 if (NONNIL(p)) 5751 { 5752 char charset[500]; 5753 XmFontList L; 5754 MLPair *q = (MLPair *)(((ML_Cons_Cell*)p.AsObjPtr())->h.AsObjPtr()); 5755 5756 Poly_string_to_C(SND(q),charset,sizeof(charset)); 5757 L = XmFontListCreate((XFontStruct *)FST(q).AsObjPtr(),charset); /* cast added SPF 6/1/94 */ 5758 5759 p = ((ML_Cons_Cell*)p.AsObjPtr())->t; 5760 5761 while(NONNIL(p)) 5762 { 5763 q = (MLPair *)(((ML_Cons_Cell*)p.AsObjPtr())->h.AsObjPtr()); 5764 5765 Poly_string_to_C(SND(q),charset,sizeof(charset)); 5766 L = XmFontListAdd(L,(XFontStruct *)FST(q).AsObjPtr(),charset); /* cast added SPF 6/1/94 */ 5767 5768 p = ((ML_Cons_Cell*)p.AsObjPtr())->t; 5769 } 5770 5771 return L; 5772 } 5773 5774 return 0; 5775} 5776 5777/* 5778 datatype CType = CAccelerators of XtAccelerators 5779 | CBool of bool 5780 | CColormap of Colormap 5781 | CCursor of Cursor 5782 | CDimension of int 5783 | CFontList of (XFontStruct * string) list 5784 | CInt of int 5785 | CIntTable of int list 5786 | CKeySym of int 5787 | CPixmap of Drawable 5788 | CPosition of int 5789 | CString of string 5790 | CStringTable of string list 5791 | CTrans of XtTranslations 5792 | CUnsignedChar of int 5793 | CUnsignedTable of int list 5794 | CVisual of Visual 5795 | CWidget of Widget 5796 | CWidgetList of Widget list 5797 | CXmString of XmString 5798 | CXmStringTable of XmString list; 5799*/ 5800 5801#define CAccelerators 1 5802#define CBool 2 5803#define CColormap 3 5804#define CCursor 4 5805#define CDimension 5 5806#define CFontList 6 5807#define CInt 7 5808#define CIntTable 8 5809#define CKeySym 9 5810#define CPixmap 10 5811#define CPosition 11 5812#define CString 12 5813#define CStringTable 13 5814#define CTrans 14 5815#define CUnsignedChar 15 5816#define CUnsignedTable 16 5817#define CVisual 17 5818#define CWidget 18 5819#define CWidgetList 19 5820#define CXmString 20 5821#define CXmStringTable 21 5822 5823typedef struct 5824{ 5825 unsigned tag; 5826 unsigned N; 5827 char *name; 5828 union 5829 { 5830 XtAccelerators acc; 5831 Boolean boolean; 5832 Colormap cmap; 5833 Cursor cursor; 5834 Dimension dim; 5835 XmFontList F; 5836 int i; 5837 int *I; 5838 KeySym keysym; 5839 Pixmap pixmap; 5840 Position posn; 5841 char *string; 5842 char **S; 5843 XtTranslations trans; 5844 uchar u; 5845 uchar *U; 5846 Visual *visual; 5847 Widget widget; 5848 WidgetList W; 5849 XmString xmString; 5850 XmString *X; 5851 } u; 5852} ArgType; 5853 5854 5855static void GetXmString(TaskData *taskData, PolyWord w, void *v, unsigned ) 5856{ 5857 XmString *p = (XmString *)v; 5858 char *s; 5859 CopyString(taskData, w, &s, 0); 5860 *p = XmStringCreateLtoR(s, (char *)XmSTRING_DEFAULT_CHARSET); 5861 free(s); 5862} 5863 5864static void GetXmStrings(TaskData *taskData, PolyWord list, ArgType *T) 5865{ 5866 T->N = 0; 5867 T->u.X = 0; 5868 5869 if (NONNIL(list)) 5870 { 5871 T->N = ListLength(list); 5872 T->u.X = (XmString *) malloc(T->N * sizeof(XmString)); 5873 5874 GetList4(taskData, list,T->u.X,sizeof(XmString),GetXmString); 5875 } 5876} 5877 5878static void GetStrings(TaskData *taskData, PolyWord list, ArgType *T) 5879{ 5880 T->N = 0; 5881 T->u.S = 0; 5882 5883 if (NONNIL(list)) 5884 { 5885 T->N = ListLength(list); 5886 T->u.S = (char **) malloc(T->N * sizeof(char *)); 5887 5888 GetList4(taskData, list,T->u.S,sizeof(char *),CopyString); 5889 } 5890} 5891 5892static void FreeXmStrings(ArgType *T) 5893{ 5894 for(unsigned i = 0; i < T->N; i++) XmStringFree (T->u.X[i]); 5895 5896 free(T->u.X); 5897} 5898 5899static void GetITable(TaskData *taskData, PolyWord list, ArgType *T) 5900{ 5901 T->N = 0; 5902 T->u.I = 0; 5903 5904 if (NONNIL(list)) 5905 { 5906 T->N = ListLength(list); 5907 T->u.I = (int *) malloc(T->N * sizeof(int)); 5908 5909 GetList4(taskData, list,T->u.I,sizeof(int),GetUnsigned); 5910 } 5911} 5912 5913static void GetUTable(TaskData *taskData, PolyWord list, ArgType *T) 5914{ 5915 T->N = 0; 5916 T->u.U = 0; 5917 5918 if (NONNIL(list)) 5919 { 5920 T->N = ListLength(list); 5921 T->u.U = (uchar *)malloc(T->N * sizeof(uchar)); 5922 5923 GetList4(taskData, list,T->u.U,sizeof(uchar),GetUChars); 5924 } 5925} 5926 5927/* 5928 case CIntTable: GetITable ((ML_Cons_Cell *)v,T); break; 5929 case CUnsignedTable: GetUTable ((ML_Cons_Cell *)v,T); break; 5930 case CString: CopyString (v,&T->u.string); break; 5931 case CStringTable: GetStrings ((ML_Cons_Cell *)v,T); break; 5932 case CXmString: GetXmString (v,&T->u.xmString); break; 5933 case CXmStringTable: GetXmStrings((ML_Cons_Cell *)v,T); break; 5934*/ 5935 5936static void FreeArgs(ArgType *T, unsigned N) 5937{ 5938 while(N--) 5939 { 5940 free(T->name); 5941 5942 switch(T->tag) 5943 { 5944 case CAccelerators: break; 5945 case CBool: break; 5946 case CColormap: break; 5947 case CCursor: break; 5948 case CDimension: break; 5949 case CFontList: XmFontListFree(T->u.F); break; 5950 case CInt: break; 5951 case CIntTable: break; 5952 case CKeySym: break; 5953 case CPixmap: break; 5954 case CPosition: break; 5955 case CString: XtFree(T->u.string); break; 5956 case CStringTable: FreeStrings(T->u.S,T->N); free(T->u.S); break; 5957 case CTrans: break; 5958 case CUnsignedChar: break; 5959 case CUnsignedTable: break; 5960 case CVisual: break; 5961 case CWidget: break; 5962 case CWidgetList: break; 5963 case CXmString: XmStringFree (T->u.xmString); break; 5964 case CXmStringTable: FreeXmStrings(T); break; 5965 5966 default: Crash ("Bad arg type %x",T->tag); 5967 } 5968 5969 T++; 5970 } 5971} 5972 5973/* 5974type Arg sharing type Arg = exn; 5975val Exn: Arg -> Exn = Cast; 5976val Arg: Exn -> Arg = Cast; 5977datatype Exn = EXN of unit ref * string * unit; 5978*/ 5979 5980/* (string,(v,tag)) */ 5981static void SetArgTypeP(TaskData *taskData, PolyWord fst, PolyWord snd, ArgType *T) 5982{ 5983 PolyWord v = FST(snd); 5984 5985 T->tag = UNTAGGED(SND(snd)); 5986 T->N = 0; 5987 T->u.i = 0; 5988 5989 CopyString(taskData, fst, &T->name, 0); 5990 5991 switch(T->tag) 5992 { 5993 case CAccelerators: T->u.acc = GetAcc (taskData, (X_Object *)v.AsObjPtr()); break; 5994 case CBool: T->u.boolean = get_C_ulong (taskData, v); break; 5995 case CColormap: T->u.cmap = GetColormap (taskData, (X_Object *)v.AsObjPtr()); break; 5996 case CCursor: T->u.cursor = GetCursor (taskData, (X_Object *)v.AsObjPtr()); break; 5997 case CDimension: T->u.dim = get_C_ushort (taskData, v); break; 5998 case CFontList: T->u.F = GetXmFontList(v); break; 5999 case CInt: T->u.i = get_C_long (taskData, v); break; 6000 case CKeySym: T->u.keysym = get_C_ulong (taskData, v); break; 6001 case CPixmap: T->u.pixmap = GetPixmap (taskData, (X_Object *)v.AsObjPtr()); break; 6002 case CPosition: T->u.posn = get_C_short (taskData, v); break; 6003 case CTrans: T->u.trans = GetTrans (taskData, (X_Object *)v.AsObjPtr()); break; 6004 case CUnsignedChar: T->u.u = get_C_uchar (taskData, v); break; 6005 case CVisual: T->u.visual = GetVisual (taskData, (X_Object *)v.AsObjPtr()); break; 6006 case CWidget: T->u.widget = GetNWidget (taskData, (X_Object *)v.AsObjPtr()); break; 6007 6008 /* The following types allocate memory, but only in the C heap */ 6009 6010 case CIntTable: GetITable (taskData, v,T); break; 6011 case CUnsignedTable: GetUTable (taskData, v,T); break; 6012 case CString: CopyString (taskData, v, &T->u.string, 0); break; 6013 case CStringTable: GetStrings (taskData, v,T); break; 6014 case CXmString: GetXmString (taskData, v, &T->u.xmString, 0); break; 6015 case CXmStringTable: GetXmStrings(taskData, v,T); break; 6016 6017 default: Crash ("Bad arg type %x",T->tag); 6018 } 6019} 6020 6021static void SetArgType(TaskData *taskData, PolyWord p, void *v, unsigned) 6022{ 6023 ArgType *T = (ArgType *)v; 6024 SetArgTypeP(taskData, FST(p), SND(p), T); 6025} 6026 6027static void SetArgs(Arg *A, ArgType *T, unsigned N) 6028{ 6029 while(N--) 6030 { 6031 A->name = T->name; 6032 6033 switch(T->tag) 6034 { 6035 case CAccelerators: A->value = (XtArgVal) T->u.acc; break; 6036 case CBool: A->value = (XtArgVal) T->u.boolean; break; 6037 case CColormap: A->value = (XtArgVal) T->u.cmap; break; 6038 case CCursor: A->value = (XtArgVal) T->u.cursor; break; 6039 case CDimension: A->value = (XtArgVal) T->u.dim; break; 6040 case CFontList: A->value = (XtArgVal) T->u.F; break; 6041 case CInt: A->value = (XtArgVal) T->u.i; break; 6042 case CIntTable: A->value = (XtArgVal) T->u.I; break; 6043 case CKeySym: A->value = (XtArgVal) T->u.keysym; break; 6044 case CPixmap: A->value = (XtArgVal) T->u.pixmap; break; 6045 case CPosition: A->value = (XtArgVal) T->u.posn; break; 6046 case CString: A->value = (XtArgVal) T->u.string; break; 6047 case CStringTable: A->value = (XtArgVal) T->u.S; break; 6048 case CTrans: A->value = (XtArgVal) T->u.trans; break; 6049 case CUnsignedChar: A->value = (XtArgVal) T->u.u; break; 6050 case CUnsignedTable: A->value = (XtArgVal) T->u.U; break; 6051 case CVisual: A->value = (XtArgVal) T->u.visual; break; 6052 case CWidget: A->value = (XtArgVal) T->u.widget; break; 6053 case CXmString: A->value = (XtArgVal) T->u.xmString; break; 6054 case CXmStringTable: A->value = (XtArgVal) T->u.X; break; 6055 6056 default: Crash ("Bad arg type %x",T->tag); 6057 } 6058 6059 A++; 6060 T++; 6061 } 6062} 6063 6064/* add current callback to (pending?) FList */ 6065static void RunWidgetCallback(Widget w, XtPointer closure, XtPointer call_data) 6066{ 6067 C_List *C = (C_List *)closure; 6068 6069 if (callbacks_enabled) 6070 { 6071 // Only synchronous callbacks are handled. 6072 TaskData *taskData = processes->GetTaskDataForThread(); 6073 Handle tailHandle = SAVE(FList); 6074 Handle widgetHandle = SAVE(C->widget_object); 6075 Handle functionHandle = SAVE(C->function); 6076 Handle pairHandle = CreatePair(taskData, widgetHandle,functionHandle); 6077 6078 FList = DEREFWORD(CreatePair(taskData, pairHandle,tailHandle)); 6079 } 6080#if 0 6081 else printf("Ignoring event for widget %p\n",C->widget_object); 6082#endif 6083} 6084 6085static void SetCallbacks(TaskData *taskData, X_Widget_Object *W, PolyWord list, PolyWord initial) 6086{ 6087 char name[100]; 6088 Widget w = GetWidget(taskData, (X_Object *)W); 6089 6090 assert(w != NULL); /* SPF */ 6091 assert(w != (Widget)1); /* SPF */ 6092 6093 for(PolyWord pp = W->callbackList; NONNIL(pp); pp = ((ML_Cons_Cell*)pp.AsObjPtr())->t) 6094 { 6095 MLPair *q = (MLPair *)((ML_Cons_Cell*)pp.AsObjPtr())->h.AsObjPtr(); 6096 6097 Poly_string_to_C(FST(q),name,sizeof(name)); 6098 6099 if (strcmp(name,"messageCallback") != 0 6100 && strcmp(name,XtNdestroyCallback) != 0) 6101 { 6102 XtRemoveAllCallbacks(w,name); 6103 } 6104 } 6105 6106#if 0 6107 /* We no longer need the old callback data for this widget, 6108 assuming we've replaced all the callbacks. But what if 6109 we've only replaced some of them? It's probably better 6110 to allow this space leak that to delete vital callback data. 6111 I'll have to think about this hard sometime. (Of course, the 6112 user isn't supposed to call XtSetCallbacks more than once, in which 6113 case the problem doesn't even arise.) SPF 29/2/96 */ 6114 PurgeCCallbacks(W,w); 6115#endif 6116 6117 for(PolyWord p = list; NONNIL(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) 6118 { 6119 C_List *C = (C_List *)malloc(sizeof(C_List)); 6120 MLPair *q = (MLPair *)((ML_Cons_Cell*)p.AsObjPtr())->h.AsObjPtr(); 6121 6122 C->function = SND(q).AsObjPtr(); 6123 C->widget_object = W; 6124 C->next = CList; 6125 6126 debugCreateCallback(W,w,C); 6127 6128 CList = C; 6129 6130 Poly_string_to_C(FST(q),name,sizeof(name)); 6131 6132 if (strcmp(name,"messageCallback") != 0 6133 && strcmp(name,XtNdestroyCallback) != 0) 6134 { 6135 XtAddCallback(w,name,RunWidgetCallback,C); 6136 } 6137 } 6138 6139 W->state = initial; 6140 W->callbackList = list; 6141} 6142 6143static void RunWidgetEventhandler (Widget w, XtPointer p, XEvent *ev, Boolean *c) 6144{ 6145 C_List *C = (C_List *)p; 6146 if ( callbacks_enabled ) 6147 { 6148 TaskData *taskData = processes->GetTaskDataForThread(); 6149 Handle tailHandle = SAVE(GList); 6150 Handle widgetHandle = SAVE(C->widget_object); 6151 Handle functionHandle = SAVE(C->function); 6152 Handle pairHandle = CreatePair(taskData, widgetHandle,functionHandle); 6153 6154 GList = (ML_Cons_Cell *)DEREFHANDLE(CreatePair(taskData, pairHandle,tailHandle)); 6155 } 6156} 6157 6158static void AddEventhandler ( 6159 TaskData *taskData, X_Widget_Object *W, EventMask EventM, Boolean nonmask, Handle p) 6160{ 6161 Widget w = GetWidget(taskData, (X_Object *)W) ; 6162 C_List *C = (C_List *) malloc ( sizeof(C_List) ) ; 6163 /* Add the function to the callback list, so that it 6164 will not be G.C'ed away. */ 6165 C->function = DEREFHANDLE(p); 6166 C->widget_object = W ; 6167 C->next = CList ; 6168 6169 CList = C ; 6170 6171 XtAddEventHandler (w, EventM, nonmask, RunWidgetEventhandler, C); 6172} 6173 6174static Handle AppInitialise 6175( 6176 TaskData *taskData, 6177 PolyWord s1, 6178 PolyWord s2, 6179 PolyWord s3, 6180 Handle fallbackHead, 6181 Handle argHead 6182 ) 6183{ 6184 char displayName[500]; 6185 char appName[500]; 6186 char appClass[500]; 6187 XtAppContext app_context; 6188 Display *display; 6189 Widget shell; 6190 Handle dsHandle /* Handle to (X_Display_Object *) */; 6191 int argc = 0; /* an "int" for Solaris, but should be "unsigned" for SunOS */ 6192 unsigned F = ListLength(DEREFWORD(fallbackHead)) + 1; 6193 unsigned N = ListLength(DEREFWORD(argHead)); 6194 char **S = (char **) alloca(F * sizeof(char *)); 6195 Arg *R = (Arg *) alloca(N * sizeof(Arg)); 6196 ArgType *T = (ArgType *) alloca(N * sizeof(ArgType)); 6197 6198 Poly_string_to_C(s1,displayName ,sizeof(displayName)); 6199 Poly_string_to_C(s2,appName ,sizeof(appName)); 6200 Poly_string_to_C(s3,appClass ,sizeof(appClass)); 6201 6202 app_context = XtCreateApplicationContext(); 6203 6204 GetList4(taskData, DEREFWORD(fallbackHead),S,sizeof(char *),CopyString); 6205 S[F-1] = NULL; /* list must be NULL terminated */ 6206 XtAppSetFallbackResources(app_context,S); 6207 6208 display = XtOpenDisplay(app_context,displayName,appName,appClass,NULL,0,&argc,0); 6209 if (display == 0) RaiseXWindows(taskData, "XtAppInitialise failed (can't open display)"); 6210 6211 /* I don't think this is needed. DCJM 26/5/2000 */ 6212 /* add_file_descr(display->fd); */ 6213 6214 debug1 ("%s display opened\n",DisplayString(display)); 6215 debug1 ("%x display fd\n",display->fd); 6216 6217 /* ok to store C values because this is a BYTE object */ 6218 dsHandle = alloc_and_save(taskData, SIZEOF(X_Display_Object), F_MUTABLE_BIT|F_BYTE_OBJ); 6219 DEREFDISPLAYHANDLE(dsHandle)->type = TAGGED(X_Display); 6220 DEREFDISPLAYHANDLE(dsHandle)->display = display; 6221 DEREFDISPLAYHANDLE(dsHandle)->screen = DefaultScreen(display); 6222 DEREFDISPLAYHANDLE(dsHandle)->app_context = app_context; 6223 AddXObject(FINISHED(taskData, dsHandle)); 6224 6225 GetList4(taskData, DEREFWORD(argHead),T,sizeof(ArgType),SetArgType); 6226 SetArgs(R,T,N); 6227 shell = XtAppCreateShell(appName,appClass,applicationShellWidgetClass,display,R,N); 6228 FreeArgs(T,N); 6229 6230 if (shell == 0) RaiseXWindows(taskData, "XtAppInitialise failed (can't create application shell)"); 6231 6232 /* added 7/12/94 SPF */ 6233 XtAddCallback(shell,XtNdestroyCallback,DestroyWidgetCallback,NULL); 6234 6235 return NewWidget(taskData, dsHandle,shell); 6236} 6237 6238static Handle CreatePopupShell 6239( 6240 TaskData *taskData, 6241 PolyStringObject *s, 6242 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6243 Widget parent, 6244 Handle list 6245) 6246{ 6247 char name[100]; Widget shell; 6248 6249 unsigned N = ListLength(DEREFWORD(list)); 6250 Arg *A = (Arg *) alloca(N * sizeof(Arg)); 6251 ArgType *T = (ArgType *) alloca(N * sizeof(ArgType)); 6252 6253 GetList4(taskData, DEREFWORD(list),T,sizeof(ArgType),SetArgType); 6254 SetArgs(A,T,N); 6255 6256 Poly_string_to_C(s,name,sizeof(name)); 6257 6258 shell = XtCreatePopupShell(name,applicationShellWidgetClass,parent,A,N); 6259 6260 FreeArgs(T,N); 6261 6262 if (shell == 0) RaiseXWindows(taskData, "XtCreatePopupShell failed"); 6263 6264 /* added 7/12/94 SPF */ 6265 XtAddCallback(shell,XtNdestroyCallback,DestroyWidgetCallback,NULL); 6266 6267 return NewWidget(taskData, dsHandle,shell); 6268} 6269 6270static Handle CreateXm 6271( 6272 TaskData *taskData, 6273 Widget (*create)(Widget, String, ArgList, Cardinal), 6274 char *failed, 6275 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6276 Widget parent, 6277 PolyStringObject *s, 6278 Handle list /* Handle to (ML_Cons_Cell *) */ 6279) 6280{ 6281 char name[100]; Widget w; 6282 6283 6284 unsigned N = ListLength(DEREFWORD(list)); 6285 Arg *A = (Arg *) alloca(N * sizeof(Arg)); 6286 ArgType *T = (ArgType *) alloca(N * sizeof(ArgType)); 6287 6288 GetList4(taskData, DEREFWORD(list),T,sizeof(ArgType),SetArgType); 6289 SetArgs(A,T,N); 6290 6291 Poly_string_to_C(s,name,sizeof(name)); 6292 6293 w = (* create)(parent,name,A,N); 6294 6295 FreeArgs(T,N); 6296 6297 if (w == 0) RaiseXWindows(taskData, failed); 6298 6299 XtAddCallback(w,XtNdestroyCallback,DestroyWidgetCallback,NULL); 6300 6301 return NewWidget(taskData, dsHandle,w); 6302} 6303 6304static void SetValues(TaskData *taskData, Widget w, Handle list) 6305{ 6306 unsigned N = ListLength(DEREFWORD(list)); 6307 Arg *A = (Arg *) alloca(N * sizeof(Arg)); 6308 ArgType *T = (ArgType *) alloca(N * sizeof(ArgType)); 6309 6310 GetList4(taskData, DEREFWORD(list),T,sizeof(ArgType),SetArgType); 6311 SetArgs(A,T,N); 6312 6313 XtSetValues(w,A,N); 6314 6315 FreeArgs(T,N); 6316} 6317 6318typedef struct 6319{ 6320 const char *listName; 6321 char *intName; 6322} StringPair; 6323 6324static StringPair listTypes[] = 6325{ 6326 {"argv" ,(char *) "argc"}, 6327 {"buttonAccelerators" ,(char *) "buttonCount"}, 6328 {"buttonAcceleratorText" ,(char *) "buttonCount"}, 6329 {"buttonMnemonicCharSets",(char *) "buttonCount"}, 6330 {"buttonMnemonics" ,(char *) "buttonCount"}, 6331 {"buttons" ,(char *) "buttonCount"}, 6332 {"buttonType" ,(char *) "buttonCount"}, 6333 {"children" ,(char *) "numChildren"}, 6334 {"dirListItems" ,(char *) "dirListItemCount"}, 6335 {"fileListItems" ,(char *) "fileListItemCount"}, 6336 {"historyItems" ,(char *) "historyItemCount"}, 6337 {"items" ,(char *) "itemCount"}, 6338 {"listItems" ,(char *) "listItemCount"}, 6339 {"selectedItems" ,(char *) "selectedItemCount"}, 6340 {"selectionArray" ,(char *) "selectionArrayCount"}, 6341}; 6342 6343#define MAXListTYPES (sizeof(listTypes)/sizeof(listTypes[0])) 6344 6345/* (string,(v,tag)) - ML (string*Ctype) */ 6346static void GetArgType 6347( 6348 TaskData *taskData, 6349 PolyWord p, 6350 ArgType *T, 6351 int i, /* not used; needed to keep function type right */ 6352 Widget w 6353) 6354{ 6355 T->tag = UNTAGGED(SND(SND(p))); 6356 T->N = 0; 6357 T->u.i = 0; 6358 6359 CopyString(taskData, FST(p), &T->name, 0); 6360 6361 if (T->tag == CIntTable || 6362 T->tag == CUnsignedTable || 6363 T->tag == CWidgetList || 6364 T->tag == CStringTable || 6365 T->tag == CXmStringTable) /* if it is a list type we need to get the length from another resource */ 6366 { 6367 Arg arg; 6368 unsigned i; 6369 int result; 6370 6371 for(i = 0; i < MAXListTYPES; i++) 6372 { 6373 if (strcmp(listTypes[i].listName,T->name) == 0) break; 6374 } 6375 6376 if (i == MAXListTYPES) Crash ("Bad list resource name %s",T->name); 6377 6378 arg.name = listTypes[i].intName; 6379 arg.value = (XtArgVal) &result; 6380 /* Bug fix here which only appeared in OpenMotif and LessTif. We need 6381 to pass the address of an integer here to receive the result. 6382 DCJM 17/5/02. */ 6383 6384 XtGetValues(w, &arg, 1); 6385 6386 T->N = result; 6387 } 6388} 6389 6390static Handle CreateWidget(TaskData *taskData, void *p, Handle dsHandle /* Handle to (X_Display_Object *) */) 6391{ 6392 return EmptyWidget(taskData, dsHandle, *(Widget*)p); 6393} 6394 6395static Handle CreateXmString(TaskData *taskData, void *t) 6396{ 6397 char *s; 6398 Handle S; 6399 6400 XmStringGetLtoR(*(XmString *)t,(char *) XmSTRING_DEFAULT_CHARSET,&s); 6401 6402 S = Make_string(s); 6403 6404 XtFree(s); 6405 6406 return S; 6407} 6408 6409static Handle CreateFontList 6410( 6411 TaskData *taskData, 6412 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6413 XmFontList F 6414 ) 6415{ 6416 XmFontContext C; 6417 XmStringCharSet charset; 6418 XFontStruct *fs; 6419 6420 Handle list = 0; 6421 Handle tail = 0; 6422 6423 if (XmFontListInitFontContext(&C,F) == False) return SAVE(ListNull); 6424 // TODO: This previously reset the save vector each time to make sure it 6425 // didn't overflow. I've removed that code but it needs to be put back. 6426 6427 while (XmFontListGetNextFont(C,&charset,&fs)) 6428 { 6429 Handle L = alloc_and_save(taskData, SIZEOF(ML_Cons_Cell), F_MUTABLE_BIT); 6430 6431 if (list == 0) list = L; // This is the first. 6432 6433 if (tail != 0) 6434 { 6435 DEREFLISTHANDLE(tail)->t = DEREFWORD(L); 6436 FINISHED(taskData, tail); 6437 } 6438 6439 tail = L; 6440 /* the new list element is joined on, but not filled in */ 6441 DEREFLISTHANDLE(tail)->h = DEREFWORD(CreatePair(taskData, CreateFontStruct(taskData,fs,dsHandle),Make_string(charset))); 6442 DEREFLISTHANDLE(tail)->t = ListNull; 6443 } 6444 6445 XmFontListFreeFontContext(C); 6446 6447 if (tail != 0) FINISHED(taskData, tail); 6448 6449 return list; 6450} 6451 6452static Handle CreateUChar(TaskData *taskData, void *p) 6453{ 6454 return Make_arbitrary_precision(taskData, *(uchar *)p); 6455} 6456 6457static Handle CreateArg(TaskData *taskData, void *v, Handle dsHandle /* Handle to (X_Display_Object *) */) 6458{ 6459 ArgType *T = (ArgType *)v; 6460 Handle value; 6461 6462 switch(T->tag) 6463 { 6464 case CAccelerators: value = EmptyAcc (taskData, T->u.acc); break; 6465 case CBool: value = Make_bool (T->u.boolean); break; 6466 case CColormap: value = EmptyColormap (taskData, dsHandle,T->u.cmap); break; 6467 case CCursor: value = EmptyCursor (taskData, dsHandle,T->u.cursor); break; 6468 case CDimension: value = Make_int (T->u.dim); break; 6469 case CFontList: value = CreateFontList(taskData, dsHandle,T->u.F); break; 6470 case CInt: value = Make_int (T->u.i); break; 6471 case CKeySym: value = Make_arbitrary_precision (taskData, T->u.keysym); break; 6472 case CPixmap: value = EmptyPixmap (taskData, dsHandle,T->u.pixmap); break; 6473 case CPosition: value = Make_int (T->u.posn); break; 6474 case CString: value = Make_string (T->u.string); break; 6475 case CTrans: value = EmptyTrans (taskData, T->u.trans); break; 6476 case CUnsignedChar: value = Make_arbitrary_precision (taskData, T->u.u); break; 6477 case CVisual: value = EmptyVisual (taskData, dsHandle,T->u.visual); break; 6478 case CWidget: value = EmptyWidget (taskData, dsHandle,T->u.widget); break; 6479 6480 case CXmString: value = CreateXmString(taskData, &T->u.xmString); break; 6481 6482 case CIntTable: value = CreateList4(taskData, T->N,T->u.I,sizeof(int), CreateUnsigned); break; 6483 case CUnsignedTable: value = CreateList4(taskData, T->N,T->u.U,sizeof(uchar), CreateUChar); break; 6484 case CStringTable: value = CreateList4(taskData, T->N,T->u.S,sizeof(char *), CreateString); break; 6485 case CWidgetList: value = CreateList5(taskData,T->N,T->u.W,sizeof(Widget), CreateWidget,dsHandle); break; 6486 case CXmStringTable: value = CreateList4(taskData, T->N,T->u.X,sizeof(XmString),CreateXmString); break; 6487 6488 default: Crash ("Bad arg type %x",T->tag); /*NOTREACHED*/ 6489 } 6490 6491 return value; 6492} 6493 6494static Handle GetValue 6495( 6496 TaskData *taskData, 6497 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6498 Widget w, 6499 PolyWord pair /* ML (string*Ctype) */ 6500 ) 6501{ 6502 Arg A; 6503 ArgType T; 6504 XmString *X = (XmString *) 0x55555555; 6505 XmString *Y = (XmString *) 0xAAAAAAAA; 6506 6507 GetArgType(taskData,pair,&T,0,w); 6508 6509 A.name = T.name; 6510 A.value = (XtArgVal) &T.u; 6511 T.u.X = X; 6512 6513 /* The value is set to X. If it is left set to X */ 6514 /* then this may be a value this widget doesn't have. */ 6515 6516 XtGetValues(w,&A,1); 6517 6518 if (T.u.X == X) 6519 { 6520 T.u.X = Y; 6521 6522 XtGetValues(w,&A,1); 6523 6524 if (T.u.X == Y) 6525 { 6526 char buffer[500]; 6527 6528 sprintf(buffer,"XtGetValues (%s) failed",T.name); 6529 6530 RaiseXWindows(taskData, buffer); 6531 } 6532 } 6533 6534 return CreateArg(taskData, &T,dsHandle); 6535} 6536 6537/* What is the real ML type of p? (string*Ctype*string*string*string*Ctype) */ 6538static void GetResource 6539( 6540 TaskData *taskData, 6541 PolyWord pp, 6542 XtResource *R, 6543 int i, 6544 ArgType *T, 6545 ArgType *D, 6546 Widget w 6547 ) 6548{ 6549 PolyObject *p = pp.AsObjPtr(); 6550 GetArgType(taskData,pp,&T[i],0,w); /* HACK !!! */ 6551 6552 CopyString(taskData, p->Get(0), &R->resource_name, 0); 6553 CopyString(taskData, p->Get(2), &R->resource_class, 0); 6554 CopyString(taskData, p->Get(3), &R->resource_type, 0); 6555 6556 R->resource_size = 4; 6557 R->resource_offset = (byte*)(&T[i].u) - (byte*)(T); 6558 6559 SetArgTypeP(taskData, p->Get(4), p->Get(5), &D[i]); /* This was a hack. I hope I converted it correctly. DCJM */ 6560 6561 R->default_type = D[i].name; 6562 6563 if (UNTAGGED(p->Get(5).AsObjPtr()->Get(1)) == CString) 6564 R->default_addr = (XtPointer) D[i].u.string; 6565 else 6566 R->default_addr = (XtPointer) &D[i].u; 6567} 6568 6569static Handle GetSubresources 6570( 6571 TaskData *taskData, 6572 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6573 Widget w, 6574 PolyStringObject *s1, 6575 PolyStringObject *s2, 6576 Handle list 6577 ) 6578{ 6579 char name [100]; 6580 char clas[100]; 6581 6582 unsigned N = ListLength(DEREFWORD(list)); 6583 ArgType *T = (ArgType *) alloca(N * sizeof(ArgType)); 6584 ArgType *D = (ArgType *) alloca(N * sizeof(ArgType)); 6585 XtResource *R = (XtResource *) alloca(N * sizeof(XtResource)); 6586 6587 { 6588 unsigned i = 0; 6589 6590 for(PolyWord p = DEREFWORD(list); NONNIL(p); p = ((ML_Cons_Cell *)p.AsObjPtr())->t) 6591 { 6592 GetResource(taskData,((ML_Cons_Cell *)p.AsObjPtr())->h,&R[i],i,T,D,w); 6593 i++; 6594 } 6595 } 6596 6597 Poly_string_to_C(s1,name ,sizeof(name)); 6598 Poly_string_to_C(s2,clas,sizeof(clas)); 6599 6600 XtGetSubresources(w,T,name,clas,R,N,NULL,0); 6601 6602 return CreateList5(taskData,N,T,sizeof(ArgType),CreateArg,dsHandle); 6603} 6604 6605static Handle GetApplicationResources (TaskData *taskData, 6606 Handle dsHandle, /* Handle to (X_Display_Object *) */ 6607 Widget w, 6608 Handle list 6609 ) 6610{ 6611 unsigned N = ListLength (DEREFLISTHANDLE(list)) ; 6612 ArgType *T = (ArgType *) alloca ( N * sizeof(ArgType) ) ; 6613 ArgType *D = (ArgType *) alloca ( N * sizeof(ArgType) ) ; 6614 XtResource *R = (XtResource *) alloca ( N * sizeof(XtResource) ) ; 6615 6616 { 6617 unsigned i = 0; 6618 for(PolyWord p = DEREFWORD(list); NONNIL(p); p = ((ML_Cons_Cell *)p.AsObjPtr())->t) 6619 { 6620 GetResource(taskData,((ML_Cons_Cell *)p.AsObjPtr())->h,&R[i],i,T,D,w); 6621 i++; 6622 } 6623 } 6624 6625 XtGetApplicationResources ( w,T,R,N,NULL,0 ) ; 6626 6627 return CreateList5 (taskData, N,T,sizeof(ArgType),CreateArg,dsHandle ) ; 6628} 6629 6630static void GetChild(TaskData *taskData, PolyWord p, void *v, unsigned) 6631{ 6632 Widget *w = (Widget *)v; 6633 *w = GetWidget(taskData, (X_Object *)p.AsObjPtr()); 6634 6635 if (XtParent(*w) == NULL) RaiseXWindows(taskData, "not a child"); 6636} 6637 6638static void ManageChildren(TaskData *taskData, Handle list) 6639{ 6640 unsigned N = ListLength(DEREFWORD(list)); 6641 Widget *W = (Widget *) alloca(N * sizeof(Widget)); 6642 6643 GetList4(taskData, DEREFWORD(list),W,sizeof(Widget),GetChild); 6644 6645 XtManageChildren(W,N); 6646} 6647 6648static void UnmanageChildren(TaskData *taskData, Handle list) 6649{ 6650 unsigned N = ListLength(DEREFWORD(list)); 6651 Widget *W = (Widget *) alloca(N * sizeof(Widget)); 6652 6653 GetList4(taskData, DEREFWORD(list),W,sizeof(Widget),GetChild); 6654 6655 XtUnmanageChildren(W,N); 6656} 6657 6658static Handle ParseTranslationTable(TaskData *taskData, PolyStringObject *s) 6659{ 6660 XtTranslations table; 6661 6662 int size = s->length + 1; 6663 char *buffer = (char *)alloca(size); 6664 6665 Poly_string_to_C(s,buffer,size); 6666 table = XtParseTranslationTable(buffer); 6667 6668 return EmptyTrans(taskData, table); 6669} 6670 6671static void CommandError(TaskData *taskData, Widget w, PolyWord s) 6672{ 6673 XmString p; 6674 GetXmString(taskData, s, &p, 0); 6675 XmCommandError(w,p); 6676 XmStringFree (p); 6677} 6678 6679static void FileSelectionDoSearch(TaskData *taskData, Widget w, PolyWord s) 6680{ 6681 XmString p; 6682 GetXmString(taskData, s, &p, 0); 6683 XmFileSelectionDoSearch(w,p); 6684 XmStringFree (p); 6685} 6686 6687static void MenuPosition (Widget w, int x, int y) 6688{ 6689 XButtonPressedEvent ev; 6690 memset (&ev, 0, sizeof(ev)); 6691 ev.type = 4; /* Must be button. */ 6692 ev.x_root = x; 6693 ev.y_root = y; 6694 ev.button = 3; /* Is this required? */ 6695 ev.same_screen = 1; /* Assume this. */ 6696 XmMenuPosition (w, &ev); 6697} 6698 6699static Handle XmIsSomething(TaskData *taskData, unsigned is_code, Widget widget) 6700{ 6701 unsigned i; 6702 6703 switch(is_code) 6704 { 6705 case 1: i = XmIsArrowButton (widget); break; 6706 case 2: i = XmIsArrowButtonGadget (widget); break; 6707 case 3: i = XmIsBulletinBoard (widget); break; 6708 case 4: i = XmIsCascadeButton (widget); break; 6709 case 5: i = XmIsCascadeButtonGadget(widget); break; 6710 case 6: i = XmIsCommand (widget); break; 6711 case 7: i = XmIsDesktopObject (widget); break; /* ok - SPF 9/8/94 */ 6712 case 8: i = XmIsDialogShell (widget); break; 6713/* Unsupported in Motif 1.2 6714 case 9: i = XmIsDisplayObject (widget); break; 6715*/ 6716 case 10: i = XmIsDrawingArea (widget); break; 6717 case 11: i = XmIsDrawnButton (widget); break; 6718 case 12: i = XmIsExtObject (widget); break; /* ok - SPF 9/8/94 */ 6719 case 13: i = XmIsFileSelectionBox (widget); break; 6720 case 14: i = XmIsForm (widget); break; 6721 case 15: i = XmIsFrame (widget); break; 6722 case 16: i = XmIsGadget (widget); break; 6723 case 17: i = XmIsLabel (widget); break; 6724 case 18: i = XmIsLabelGadget (widget); break; 6725 case 19: i = XmIsList (widget); break; 6726 case 20: i = XmIsMainWindow (widget); break; 6727 case 21: i = XmIsManager (widget); break; 6728 case 22: i = XmIsMenuShell (widget); break; 6729 case 23: i = XmIsMessageBox (widget); break; 6730 case 24: i = XmIsMotifWMRunning (widget); break; 6731 case 25: i = XmIsPanedWindow (widget); break; 6732 case 26: i = XmIsPrimitive (widget); break; 6733 case 27: i = XmIsPushButton (widget); break; 6734 case 28: i = XmIsPushButtonGadget (widget); break; 6735 case 29: i = XmIsRowColumn (widget); break; 6736 case 30: i = XmIsScale (widget); break; 6737/* Unsupported in Motif 1.2 6738 case 31: i = XmIsScreenObject (widget); break; 6739*/ 6740 case 32: i = XmIsScrollBar (widget); break; 6741 case 33: i = XmIsScrolledWindow (widget); break; 6742 case 34: i = XmIsSelectionBox (widget); break; 6743 case 35: i = XmIsSeparator (widget); break; 6744 case 36: i = XmIsSeparatorGadget (widget); break; 6745#ifdef LESSTIF_VERSION 6746/* This is not supported in LessTif, at least not 0.89. */ 6747 case 37: RaiseXWindows(taskData, "XmIsShellExt: not implemented"); 6748#else 6749 case 37: i = XmIsShellExt (widget); break; /* ok - SPF 9/8/94 */ 6750#endif 6751 case 38: i = XmIsText (widget); break; 6752 case 39: i = XmIsTextField (widget); break; 6753 case 40: i = XmIsToggleButton (widget); break; 6754 case 41: i = XmIsToggleButtonGadget (widget); break; 6755 case 42: i = XmIsVendorShell (widget); break; 6756 case 43: i = XmIsVendorShellExt (widget); break; /* ok - SPF 9/8/94 */ 6757/* Unsupported in Motif 1.2 6758 case 44: i = XmIsWorldObject (widget); break; 6759*/ 6760 6761 default: Crash ("Bad code (%d) in XmIsSomething",is_code); 6762 /* NOTREACHED*/ 6763 } 6764 6765 return Make_bool(i); 6766} 6767 6768 6769/******************************************************************************/ 6770/* */ 6771/* Wrappers for standard widget operations */ 6772/* */ 6773/******************************************************************************/ 6774 6775/************************* 0 parameters, no result ****************************/ 6776 6777/* widget -> unit */ 6778static void WidgetAction 6779( 6780 TaskData *taskData, 6781 char *func_name, 6782 Widget getWidget(TaskData *, char *, X_Object *), 6783 void applyFunc(Widget), 6784 X_Object *arg1 6785) 6786{ 6787 Widget w = getWidget(taskData,func_name,arg1); 6788 applyFunc(w); 6789} 6790 6791/************************* 1 parameter, no result *****************************/ 6792 6793/* widget -> bool -> unit */ 6794static void WidgetBoolAction 6795( 6796 TaskData *taskData, 6797 char *func_name, 6798 Widget getWidget(TaskData *, char *, X_Object *), 6799 void applyFunc(Widget, Boolean), 6800 X_Object *arg1, 6801 PolyWord arg2 6802) 6803{ 6804 Widget w = getWidget(taskData,func_name,arg1); 6805 Boolean b = (get_C_short(taskData, arg2) != 0); 6806 applyFunc(w,b); 6807} 6808 6809/* widget -> int -> unit */ 6810static void WidgetIntAction 6811( 6812 TaskData *taskData, 6813 char *func_name, 6814 Widget getWidget(TaskData *, char *, X_Object *), 6815 void applyFunc(Widget, int), 6816 X_Object *arg1, 6817 PolyWord arg2 6818) 6819{ 6820 Widget w = getWidget(taskData,func_name,arg1); 6821 int i = get_C_long(taskData, arg2); 6822 applyFunc(w,i); 6823} 6824 6825/* widget -> int -> unit */ 6826static void WidgetLongAction 6827( 6828 TaskData *taskData, 6829 char *func_name, 6830 Widget getWidget(TaskData *, char *, X_Object *), 6831 void applyFunc(Widget, long), 6832 X_Object *arg1, 6833 PolyWord arg2 6834) 6835{ 6836 Widget w = getWidget(taskData,func_name,arg1); 6837 long i = get_C_long(taskData, arg2); 6838 applyFunc(w,i); 6839} 6840 6841/* widget -> string -> unit */ 6842static void WidgetXmstringAction 6843( 6844 TaskData *taskData, 6845 char *func_name, 6846 Widget getWidget(TaskData *, char *, X_Object *), 6847 void applyFunc(Widget, XmString), 6848 X_Object *arg1, 6849 PolyWord arg2 6850) 6851{ 6852 Widget w = getWidget(taskData,func_name,arg1); 6853 XmString s; 6854 GetXmString(taskData, arg2, &s, 0); 6855 applyFunc(w,s); 6856 XmStringFree(s); 6857} 6858 6859 6860/* widget -> string list -> unit */ 6861static void WidgetXmstringlistAction 6862( 6863 TaskData *taskData, 6864 char *func_name, 6865 Widget getWidget(TaskData *, char *, X_Object *), 6866 void applyFunc(Widget, XmString *, int), 6867 X_Object *arg1, 6868 ML_Cons_Cell *arg2 6869) 6870{ 6871 Widget w = getWidget(taskData,func_name,arg1); 6872 unsigned n = ListLength(arg2); 6873 XmString *strings = (XmString *)alloca(n * sizeof(XmString)); 6874 GetList4(taskData, arg2,strings,sizeof(XmString),GetXmString); 6875 applyFunc(w,strings,n); 6876 for (unsigned i = 0; i < n; i ++) XmStringFree(strings[i]); 6877} 6878 6879/************************* 2 parameters, no result ****************************/ 6880 6881/* widget -> int -> bool -> unit */ 6882static void WidgetIntBoolAction 6883( 6884 TaskData *taskData, 6885 char *func_name, 6886 Widget getWidget(TaskData *, char *, X_Object *), 6887 void applyFunc(Widget, int, Boolean), 6888 X_Object *arg1, 6889 PolyWord arg2, 6890 PolyWord arg3 6891) 6892{ 6893 Widget w = getWidget(taskData,func_name,arg1); 6894 int i = get_C_long(taskData, arg2); 6895 Boolean b = (get_C_ushort(taskData, arg3) != 0); 6896 applyFunc(w,i,b); 6897} 6898 6899/* widget -> int -> int -> unit */ 6900static void WidgetIntIntAction 6901( 6902 TaskData *taskData, 6903 char *func_name, 6904 Widget getWidget(TaskData *, char *, X_Object *), 6905 void applyFunc(Widget, int, int), 6906 X_Object *arg1, 6907 PolyWord arg2, 6908 PolyWord arg3 6909) 6910{ 6911 Widget w = getWidget(taskData,func_name,arg1); 6912 int x = get_C_long(taskData, arg2); 6913 int y = get_C_long(taskData, arg3); 6914 applyFunc(w,x,y); 6915} 6916 6917/* widget -> string -> bool -> unit */ 6918static void WidgetXmstringBoolAction 6919( 6920 TaskData *taskData, 6921 char *func_name, 6922 Widget getWidget(TaskData *, char *, X_Object *), 6923 void applyFunc(Widget, XmString, Boolean), 6924 X_Object *arg1, 6925 PolyWord arg2, 6926 PolyWord arg3 6927) 6928{ 6929 Widget w = getWidget(taskData,func_name,arg1); 6930 XmString s; 6931 Boolean b = (get_C_ushort(taskData, arg3) != 0); 6932 6933 GetXmString(taskData, arg2, &s, 0); 6934 applyFunc(w,s,b); 6935 XmStringFree(s); 6936} 6937 6938 6939/* widget -> string -> int -> unit */ 6940static void WidgetXmstringIntAction 6941( 6942 TaskData *taskData, 6943 char *func_name, 6944 Widget getWidget(TaskData *, char *, X_Object *), 6945 void applyFunc(Widget, XmString, int), 6946 X_Object *arg1, 6947 PolyWord arg2, 6948 PolyWord arg3 6949) 6950{ 6951 Widget w = getWidget(taskData,func_name,arg1); 6952 XmString s; 6953 int i = get_C_long(taskData, arg3); 6954 GetXmString(taskData, arg2, &s, 0); 6955 applyFunc(w,s,i); 6956 XmStringFree(s); 6957} 6958 6959/* widget -> string list -> int -> unit */ 6960static void WidgetXmstringlistIntAction 6961( 6962 TaskData *taskData, 6963 char *func_name, 6964 Widget getWidget(TaskData *, char *, X_Object *), 6965 void applyFunc(Widget, XmString *, int, int), 6966 X_Object *arg1, 6967 ML_Cons_Cell *arg2, 6968 PolyWord arg3 6969) 6970{ 6971 Widget w = getWidget(taskData,func_name,arg1); 6972 unsigned n = ListLength(arg2); 6973 int i = get_C_long(taskData, arg3); 6974 XmString *strings = (XmString *)alloca(n * sizeof(XmString)); 6975 6976 GetList4(taskData, arg2,strings,sizeof(XmString),GetXmString); 6977 applyFunc(w,strings,n,i); 6978 for (unsigned i = 0; i < n; i ++) XmStringFree(strings[i]); 6979} 6980 6981/************************* n parameters, some result **************************/ 6982static Handle int_ptr_to_arb(TaskData *taskData, void *p) 6983{ 6984 return Make_arbitrary_precision(taskData, *(int *)p); 6985} 6986 6987/* widget -> int */ 6988static Handle WidgetToInt 6989( 6990 TaskData *taskData, 6991 char *func_name, 6992 Widget getWidget(TaskData *, char *, X_Object *), 6993 int applyFunc(Widget), 6994 X_Object *arg1 6995) 6996{ 6997 Widget w = getWidget(taskData, func_name,arg1); 6998 int res = applyFunc(w); 6999 return(Make_arbitrary_precision(taskData, res)); 7000} 7001 7002/* widget -> int */ 7003static Handle WidgetToLong 7004( 7005 TaskData *taskData, 7006 char *func_name, 7007 Widget getWidget(TaskData *taskData, char *, X_Object *), 7008 long applyFunc(Widget), 7009 X_Object *arg1 7010) 7011{ 7012 Widget w = getWidget(taskData, func_name,arg1); 7013 long res = applyFunc(w); 7014 return(Make_arbitrary_precision(taskData, res)); 7015} 7016 7017#if 0 7018/* widget -> int */ 7019static Handle WidgetToUnsigned 7020( 7021 TaskData *taskData, 7022 char *func_name, 7023 Widget getWidget(TaskData *, char *, X_Object *), 7024 unsigned applyFunc(Widget), 7025 X_Object *arg1 7026) 7027{ 7028 Widget w = getWidget(taskData, func_name,arg1); 7029 unsigned res = applyFunc(w); 7030 return(Make_arbitrary_precision(taskData, res)); 7031} 7032#endif 7033 7034/* widget -> bool */ 7035static Handle WidgetToBool 7036( 7037 TaskData *taskData, 7038 char *func_name, 7039 Widget getWidget(TaskData *, char *, X_Object *), 7040 Boolean applyFunc(Widget), 7041 X_Object *arg1 7042) 7043{ 7044 Widget w = getWidget(taskData, func_name,arg1); 7045 Boolean res = applyFunc(w); 7046 return(Make_bool(res)); 7047} 7048 7049/* widget -> string */ 7050static Handle WidgetToString 7051( 7052 TaskData *taskData, 7053 char *func_name, 7054 Widget getWidget(TaskData *, char *, X_Object *), 7055 char *applyFunc(Widget), 7056 X_Object *arg1 7057) 7058{ 7059 Widget w = getWidget(taskData, func_name,arg1); 7060 char *s = applyFunc(w); 7061 Handle res = Make_string(s); /* safe, even if C pointer is NULL */ 7062 XtFree(s); 7063 return(res); 7064} 7065 7066/* widget -> int list */ 7067static Handle WidgetToIntlist 7068( 7069 TaskData *taskData, 7070 char *func_name, 7071 Widget getWidget(TaskData *, char *, X_Object *), 7072 Boolean applyFunc(Widget, int**, int *), 7073 X_Object *arg1 7074) 7075{ 7076 int item_count, *items; 7077 Boolean non_empty; 7078 Widget w = getWidget(taskData,func_name,arg1); 7079 7080 non_empty = applyFunc(w, &items, &item_count); 7081 7082 if (non_empty != TRUE) 7083 /* nothing found, and Motif hasn't allocated any space */ 7084 /* so just retun nil */ 7085 { 7086 return (SAVE(ListNull)); 7087 } 7088 else 7089 /* copy the list into the ML heap, then free it */ 7090 { 7091 Handle res = CreateList4(taskData, item_count,items,sizeof(int),int_ptr_to_arb); 7092 XtFree((char *)items); 7093 return res; 7094 } 7095} 7096 7097/* widget -> string -> int list */ 7098static Handle WidgetXmstringToIntlist 7099( 7100 TaskData *taskData, 7101 char *func_name, 7102 Widget getWidget(TaskData *, char *, X_Object *), 7103 Boolean applyFunc(Widget, XmString, int**, int *), 7104 X_Object *arg1, 7105 PolyWord arg2 7106) 7107{ 7108 int item_count, *items; 7109 Boolean non_empty; 7110 Widget w = getWidget(taskData,func_name,arg1); 7111 XmString s; 7112 7113 GetXmString(taskData, arg2, &s, 0); 7114 non_empty = applyFunc(w, s, &items, &item_count); 7115 XmStringFree(s); 7116 7117 if (non_empty != TRUE) 7118 /* nothing found, so just retun nil */ 7119 { 7120 return (SAVE(ListNull)); 7121 } 7122 else 7123 /* copy the list into the ML heap, then free it */ 7124 { 7125 Handle res = CreateList4(taskData, item_count,items,sizeof(int),int_ptr_to_arb); 7126 XtFree((char *)items); 7127 return res; 7128 } 7129} 7130 7131/* widget -> string -> int */ 7132static Handle WidgetXmstringToInt 7133( 7134 TaskData *taskData, 7135 char *func_name, 7136 Widget getWidget(TaskData *, char *, X_Object *), 7137 int applyFunc(Widget, XmString), 7138 X_Object *arg1, 7139 PolyWord arg2 7140) 7141{ 7142 Widget w = getWidget(taskData,func_name,arg1); 7143 XmString s; 7144 int res; 7145 7146 GetXmString(taskData, arg2, &s, 0); 7147 res = applyFunc(w, s); 7148 XmStringFree(s); 7149 7150 return (Make_int(res)); 7151} 7152 7153/* widget -> string -> bool */ 7154static Handle WidgetXmstringToBool 7155( 7156 TaskData *taskData, 7157 char *func_name, 7158 Widget getWidget(TaskData *, char *, X_Object *), 7159 Boolean applyFunc(Widget, XmString), 7160 X_Object *arg1, 7161 PolyWord arg2 7162) 7163{ 7164 Widget w = getWidget(taskData,func_name,arg1); 7165 XmString s; 7166 Boolean res; 7167 7168 GetXmString(taskData, arg2, &s, 0); 7169 res = applyFunc(w, s); 7170 XmStringFree(s); 7171 7172 return (Make_bool(res)); 7173} 7174 7175 7176/******************************************************************************/ 7177 7178/* code added SPF 25/2/95 */ 7179static bool isPossibleString(PolyObject *P) 7180{ 7181 if (!OBJ_IS_DATAPTR(P)) return false; 7182 7183 POLYUNSIGNED L = P->LengthWord(); 7184 7185 if (! OBJ_IS_BYTE_OBJECT(L)) return false; 7186 7187 /* get object PolyWord count */ 7188 POLYUNSIGNED n = OBJ_OBJECT_LENGTH(L); 7189 7190 if (n < 1) return false; 7191 7192 /* get string byte count */ 7193 POLYUNSIGNED m = P->Get(0).AsUnsigned(); 7194 7195 /* number of words to hold the bytes */ 7196 m = (m + 3) / 4; 7197 7198 /* number of words to hold the bytes, plus the byte count */ 7199 m = m + 1; 7200 7201 /* If that's the same as the object PolyWord count, 7202 we've probably got a genuine string! */ 7203 return (m == n); 7204} 7205 7206/* Prints out the contents of a PolyWord in the X interface tuple */ 7207static void DebugPrintWord(PolyWord P /* was X_Object *P */) 7208{ 7209 TaskData *taskData = processes->GetTaskDataForThread(); 7210 if (IS_INT((P))) 7211 { 7212 printf("Short %d", (int)UNTAGGED(P)); 7213 return; 7214 } 7215 7216 if (isPossibleString(P.AsObjPtr())) 7217 { 7218 if (((PolyStringObject*)P.AsObjPtr())->length <= 40) 7219 { 7220 printf("String: \""); 7221 print_string((PolyStringObject*) P.AsObjPtr()); 7222 printf("\""); 7223 return; 7224 } 7225 else 7226 { 7227 printf("Long String: %p", P.AsAddress()); 7228 return; 7229 } 7230 } 7231 7232 /* The problem with the following code was that we can't be sure 7233 that the object we have is really an X_Object - it might just 7234 look like one. If this is the case, when we try to validate 7235 the object using ResourceExists we may get a core dump because 7236 ResourceExists assumes it has a valid X_Object and calls 7237 hashId which dereferences fields within the so-called X_object. 7238 That's why we redefine ResourceExists to be SafeResourceExists 7239 which doesn't make any assumptions about the contents of the 7240 so-called X_object. SPF 6/4/95 */ 7241 7242#define XP ((X_Object *)P.AsObjPtr()) 7243#define ResourceExists SafeResourceExists 7244 { 7245 switch(UNTAGGED(XP->type)) 7246 { 7247 case X_GC: (ResourceExists(XP) 7248 ? printf("GC %lx", GetGC(taskData, XP)->gid) 7249 : printf("Old GC <%lx>",P.AsUnsigned())); 7250 return; 7251 7252 case X_Font: (ResourceExists(XP) 7253 ? printf("Font %lx",GetFont(taskData, XP)) 7254 : printf("Old Font <%x>",(int)P.AsUnsigned())); 7255 return; 7256 7257 case X_Cursor: (ResourceExists(XP) 7258 ? printf("Cursor %lx",GetCursor(taskData, XP)) 7259 : printf("Old Cursor <%x>",(int)P.AsUnsigned())); 7260 return; 7261 7262 case X_Window: (ResourceExists(XP) 7263 ? printf("Window %lx",GetWindow(taskData, XP)) 7264 : printf("Old Window <%p>",P.AsAddress())); 7265 return; 7266 7267 case X_Pixmap: (ResourceExists(XP) 7268 ? printf("Pixmap %lx",GetPixmap(taskData, XP)) 7269 : printf("Old Pixmap <%p>",P.AsAddress())); 7270 return; 7271 7272 case X_Colormap: (ResourceExists(XP) 7273 ? printf("Colormap %lx",GetColormap(taskData, XP)) 7274 : printf("Old Colormap <%p>",P.AsAddress())); 7275 return; 7276 7277 case X_Visual: (ResourceExists(XP) 7278 ? printf("Visual %lx",GetVisual(taskData, XP)->visualid) 7279 : printf("Old Visual <%p>",P.AsAddress())); 7280 return; 7281 7282 case X_Widget: (ResourceExists(XP) 7283 ? printf("Widget %p",GetNWidget(taskData, XP)) 7284 : printf("Old Widget <%p>",P.AsAddress())); 7285 return; 7286 7287 case X_Trans: (ResourceExists(XP) 7288 ? printf("Trans %p",GetTrans(taskData, XP)) 7289 : printf("Old Trans <%p>",P.AsAddress())); 7290 return; 7291 7292 case X_Acc: (ResourceExists(XP) 7293 ? printf("Acc %p",GetAcc(taskData, XP)) 7294 : printf("Old Acc <%p>",P.AsAddress())); 7295 return; 7296 7297 case X_Display: (ResourceExists(XP) 7298 ? printf("Display %s", DisplayString(GetDisplay(taskData, XP))) 7299 + printf(":%x", GetDisplay(taskData, XP)->fd) 7300 : printf("Old Display <%p>",P.AsAddress())); 7301 return; 7302 7303 default: printf("Pointer "ZERO_X"%p",P.AsAddress()); 7304 return; 7305 } 7306 } 7307#undef ResourceExists 7308#undef XP 7309} 7310 7311/* Prints out the contents of the X interface tuple */ 7312static void DebugPrintCode(PolyObject *pt) 7313{ 7314 POLYUNSIGNED N = pt->Length(); 7315 POLYUNSIGNED i = 1; 7316 assert(IS_INT(pt->Get(0))); 7317 7318 printf("%ld:(", UNTAGGED(pt->Get(0))); 7319 7320 while(i < N) 7321 { 7322 DebugPrintWord(pt->Get(i++)); 7323 if (i < N) 7324 printf(","); 7325 } 7326 7327 printf(")\n"); 7328} 7329 7330#define P0 DEREFHANDLE(params)->Get(0) 7331#define P1 DEREFHANDLE(params)->Get(1) 7332#define P2 DEREFHANDLE(params)->Get(2) 7333#define P3 DEREFHANDLE(params)->Get(3) 7334#define P4 DEREFHANDLE(params)->Get(4) 7335#define P5 DEREFHANDLE(params)->Get(5) 7336#define P6 DEREFHANDLE(params)->Get(6) 7337#define P7 DEREFHANDLE(params)->Get(7) 7338#define P8 DEREFHANDLE(params)->Get(8) 7339#define P9 DEREFHANDLE(params)->Get(9) 7340#define P10 DEREFHANDLE(params)->Get(10) 7341#define P11 DEREFHANDLE(params)->Get(11) 7342#define P12 DEREFHANDLE(params)->Get(12) 7343 7344#define XP1 ((X_Object *)P1.AsObjPtr()) 7345#define XP2 ((X_Object *)P2.AsObjPtr()) 7346#define XP3 ((X_Object *)P3.AsObjPtr()) 7347#define XP4 ((X_Object *)P4.AsObjPtr()) 7348#define XP5 ((X_Object *)P5.AsObjPtr()) 7349#define XP6 ((X_Object *)P6.AsObjPtr()) 7350#define XP7 ((X_Object *)P7.AsObjPtr()) 7351 7352/* Xwindows_c gets passed the address of an object in save_vec, */ 7353/* which is itself a pointer to a tuple in the Poly heap. */ 7354 7355Handle XWindows_c(TaskData *taskData, Handle params) 7356{ 7357 int code = get_C_short(taskData, P0); 7358 7359 if ((debugOptions & DEBUG_X)) DebugPrintCode(DEREFHANDLE(params)); 7360 7361 switch(code) 7362 { 7363 case XCALL_Not: 7364 return Make_arbitrary_precision(taskData, ~ get_C_ulong(taskData, P1)); 7365 7366 case XCALL_And: 7367 return Make_arbitrary_precision(taskData, get_C_ulong(taskData, P1) & get_C_ulong(taskData, P2)); 7368 7369 case XCALL_Or: 7370 return Make_arbitrary_precision(taskData, get_C_ulong(taskData, P1) | get_C_ulong(taskData, P2)); 7371 7372 case XCALL_Xor: 7373 return Make_arbitrary_precision(taskData, get_C_ulong(taskData, P1) ^ get_C_ulong(taskData, P2)); 7374 7375 case XCALL_DownShift: 7376 return Make_arbitrary_precision(taskData, get_C_ulong(taskData, P1) >> get_C_ulong(taskData, P2)); 7377 7378 case XCALL_UpShift: 7379 return Make_arbitrary_precision(taskData, get_C_ulong(taskData, P1) << get_C_ulong(taskData, P2)); 7380 7381 case XCALL_NoDrawable: 7382 return EmptyPixmap(taskData, SAVE(ListNull),(Pixmap)get_C_ulong(taskData, P1)); 7383 7384 case XCALL_NoCursor: 7385 return EmptyCursor(taskData, SAVE(ListNull),(Cursor)None); 7386 7387 case XCALL_NoFont: 7388 return EmptyFont(taskData, SAVE(ListNull),(Font)None,(XFontStruct *)NULL); 7389 7390 case XCALL_NoColormap: 7391 return EmptyColormap(taskData, SAVE(ListNull),(Colormap) None); 7392 7393 case XCALL_NoVisual: 7394 return EmptyVisual(taskData, SAVE(ListNull),(Visual *)None); 7395 7396 case XCALL_GetTimeOfDay: 7397 return GetTimeOfDay(taskData); 7398 7399 /* Colorcells 100 */ 7400 case XCALL_XAllocColor: 7401 return AllocColor(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),GetXColor1(taskData, P2)); 7402 7403 case XCALL_XAllocColorCells: 7404 return AllocColorCells(taskData, GetDisplay(taskData, XP1), 7405 GetColormap(taskData, XP1), 7406 get_C_ulong(taskData, P2), 7407 get_C_ulong(taskData, P3), 7408 get_C_ulong(taskData, P4)); 7409 7410 case XCALL_XAllocColorPlanes: 7411 return AllocColorPlanes(taskData, GetDisplay(taskData, XP1), 7412 GetColormap(taskData, XP1), 7413 get_C_ulong(taskData, P2), 7414 get_C_ulong(taskData, P3), 7415 get_C_ulong(taskData, P4), 7416 get_C_ulong(taskData, P5), 7417 get_C_ulong(taskData, P6)); 7418 7419 case XCALL_XAllocNamedColor: 7420 return AllocNamedColor(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),GetString(P2)); 7421 7422 case XCALL_XFreeColors: 7423 FreeColors(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),SAVE(P2),get_C_ulong(taskData, P3)); 7424 break; 7425 7426 case XCALL_XLookupColor: 7427 return LookupColor(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),GetString(P2)); 7428 7429 case XCALL_XParseColor: 7430 return ParseColor(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),GetString(P2)); 7431 7432 case XCALL_XQueryColor: 7433 return QueryColor(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),get_C_ulong(taskData, P2)); 7434 7435 case XCALL_XQueryColors: 7436 return QueryColors(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),SAVE(P2)); 7437 7438 case XCALL_XStoreColor: 7439 XStoreColor(GetDisplay(taskData, XP1),GetColormap(taskData, XP1),GetXColor1(taskData, P2)); 7440 break; 7441 7442 case XCALL_XStoreColors: 7443 StoreColors(taskData, GetDisplay(taskData, XP1),GetColormap(taskData, XP1),SAVE(P2)); 7444 break; 7445 7446 case XCALL_XStoreNamedColor: 7447 StoreNamedColor(GetDisplay(taskData, XP1), 7448 GetColormap(taskData, XP1), 7449 GetString(P2), 7450 get_C_ulong(taskData, P3), 7451 get_C_ulong(taskData, P4), 7452 get_C_ulong(taskData, P5), 7453 get_C_ulong(taskData, P6)); 7454 break; 7455 7456 case XCALL_BlackPixel: 7457 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7458 return Make_arbitrary_precision(taskData, BlackPixel(DEREFDISPLAYHANDLE(dsHandle)->display, 7459 DEREFDISPLAYHANDLE(dsHandle)->screen)); } 7460 7461 case XCALL_WhitePixel: 7462 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7463 return Make_arbitrary_precision(taskData, WhitePixel(DEREFDISPLAYHANDLE(dsHandle)->display, 7464 DEREFDISPLAYHANDLE(dsHandle)->screen)); } 7465 7466 /* Colormaps 150 */ 7467 case XCALL_XCopyColormapAndFree: 7468 return EmptyColormap(taskData, GetDS(taskData, XP1),XCopyColormapAndFree(GetDisplay(taskData, XP1),GetColormap(taskData, XP1))); 7469 7470 case XCALL_XCreateColormap: 7471 return EmptyColormap(taskData, GetDS(taskData, XP1),XCreateColormap(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetVisual(taskData, XP2),get_C_ulong(taskData, P3))); 7472 7473 case XCALL_XInstallColormap: 7474 XInstallColormap(GetDisplay(taskData, XP1),GetColormap(taskData, XP1)); break; 7475 7476 case XCALL_XListInstalledColormaps: 7477 return ListInstalledColormaps(taskData, GetDS(taskData, XP1),GetDrawable(taskData, XP1)); 7478 7479 case XCALL_XUninstallColormap: 7480 XUninstallColormap(GetDisplay(taskData, XP1),GetColormap(taskData, XP1)); break; 7481 7482 case XCALL_DefaultColormap: 7483 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7484 return EmptyColormap(taskData, dsHandle, 7485 DefaultColormap(DEREFDISPLAYHANDLE(dsHandle)->display, 7486 DEREFDISPLAYHANDLE(dsHandle)->screen)); 7487 } 7488 7489 case XCALL_DefaultVisual: 7490 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7491 return EmptyVisual(taskData, dsHandle, 7492 DefaultVisual(DEREFDISPLAYHANDLE(dsHandle)->display, 7493 DEREFDISPLAYHANDLE(dsHandle)->screen)); 7494 } 7495 7496 case XCALL_DisplayCells: 7497 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7498 return Make_arbitrary_precision(taskData, DisplayCells(DEREFDISPLAYHANDLE(dsHandle)->display, 7499 DEREFDISPLAYHANDLE(dsHandle)->screen)); 7500 } 7501 7502 case XCALL_VisualClass: 7503 return Make_arbitrary_precision(taskData, GetVisual(taskData, XP1)->c_class); 7504 7505 case XCALL_VisualRedMask: 7506 return Make_arbitrary_precision(taskData, GetVisual(taskData, XP1)->red_mask); 7507 7508 case XCALL_VisualGreenMask: 7509 return Make_arbitrary_precision(taskData, GetVisual(taskData, XP1)->green_mask); 7510 7511 case XCALL_VisualBlueMask: 7512 return Make_arbitrary_precision(taskData, GetVisual(taskData, XP1)->blue_mask); 7513 7514 /* Cursors 200 */ 7515 case XCALL_XCreateFontCursor: 7516 return CreateFontCursor(taskData, GetDS(taskData, XP1),get_C_ulong(taskData, P2)); 7517 7518 case XCALL_XCreateGlyphCursor: 7519 return CreateGlyphCursor(taskData, GetDS(taskData, XP1), 7520 GetFont(taskData, XP1), 7521 GetFont(taskData, XP2), 7522 get_C_ulong(taskData, P3), 7523 get_C_ulong(taskData, P4), 7524 GetXColor1(taskData, P5), 7525 GetXColor2(taskData, P6)); 7526 7527 case XCALL_XCreatePixmapCursor: 7528 return CreatePixmapCursor(taskData, GetDS(taskData, XP1), 7529 GetPixmap(taskData, XP1), /* source */ 7530 GetPixmap(taskData, XP2), /* mask */ 7531 GetXColor1(taskData, P3), /* foreground */ 7532 GetXColor2(taskData, P4), /* background */ 7533 GetOffsetX(taskData, P5), /* x */ 7534 GetOffsetY(taskData, P5) /* y */); 7535 7536 case XCALL_XDefineCursor: 7537 XDefineCursor(GetDisplay(taskData, XP1),GetWindow(taskData, XP1),GetCursor(taskData, XP2)); 7538 WindowObject(XP1)->cursor_object = CursorObject(XP2); 7539 break; 7540 7541 case XCALL_XQueryBestCursor: 7542 CheckZeroRect(taskData, P2); 7543 return QueryBest(taskData, XQueryBestCursor, 7544 GetDisplay(taskData, XP1), 7545 GetDrawable(taskData, XP1), 7546 GetRectW(taskData, P2), 7547 GetRectH(taskData, P2)); 7548 7549 case XCALL_XRecolorCursor: 7550 XRecolorCursor(GetDisplay(taskData, XP1), 7551 GetCursor(taskData, XP1), 7552 GetXColor1(taskData, P2), 7553 GetXColor2(taskData, P3)); 7554 break; 7555 7556 case XCALL_XUndefineCursor: 7557 XUndefineCursor(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 7558 WindowObject(XP1)->cursor_object = 0; 7559 break; 7560 7561 /* Display Specifications 250 */ 7562 7563 case XCALL_XOpenDisplay: 7564 return OpenDisplay(taskData, GetString(XP1)); 7565 7566#define DODISPLAYOP(op) \ 7567 {\ 7568 Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1);\ 7569 return Make_arbitrary_precision(taskData, op(DEREFDISPLAYHANDLE(dsHandle)->display,\ 7570 DEREFDISPLAYHANDLE(dsHandle)->screen));\ 7571 } 7572 7573 case XCALL_CellsOfScreen: 7574 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7575 return Make_arbitrary_precision(taskData, CellsOfScreen(ScreenOfDisplay(DEREFDISPLAYHANDLE(dsHandle)->display, 7576 DEREFDISPLAYHANDLE(dsHandle)->screen))); 7577 } 7578 7579 case XCALL_DefaultDepth: 7580 DODISPLAYOP(DefaultDepth) 7581 7582 case XCALL_DisplayHeight: 7583 DODISPLAYOP(DisplayHeight) 7584 7585 case XCALL_DisplayHeightMM: 7586 DODISPLAYOP(DisplayHeightMM) 7587 7588 case XCALL_DisplayPlanes: 7589 DODISPLAYOP(DisplayPlanes) 7590 7591 case XCALL_DisplayString: 7592 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7593 return Make_string(DisplayString(DEREFDISPLAYHANDLE(dsHandle)->display)); 7594 } 7595 7596 case XCALL_DisplayWidth: 7597 DODISPLAYOP(DisplayWidth) 7598 7599 case XCALL_DisplayWidthMM: 7600 DODISPLAYOP(DisplayWidthMM) 7601#undef DODISPLAYOP 7602 7603 7604#define DODISPLAYSCREENOP(op) \ 7605 {\ 7606 Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1);\ 7607 return Make_arbitrary_precision(taskData, op(ScreenOfDisplay(DEREFDISPLAYHANDLE(dsHandle)->display,\ 7608 DEREFDISPLAYHANDLE(dsHandle)->screen)));\ 7609 } 7610 7611 case XCALL_DoesBackingStore: 7612 DODISPLAYSCREENOP(DoesBackingStore) 7613 7614 case XCALL_DoesSaveUnders: 7615 DODISPLAYSCREENOP(DoesSaveUnders) 7616 7617 case XCALL_EventMaskOfScreen: 7618 DODISPLAYSCREENOP(EventMaskOfScreen) 7619 7620 case XCALL_MaxCmapsOfScreen: 7621 DODISPLAYSCREENOP(MaxCmapsOfScreen) 7622 7623 case XCALL_MinCmapsOfScreen: 7624 DODISPLAYSCREENOP(MinCmapsOfScreen) 7625#undef DODISPLAYSCREENOP 7626 7627 case XCALL_ProtocolRevision: 7628 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7629 return Make_arbitrary_precision(taskData, ProtocolRevision(DEREFDISPLAYHANDLE(dsHandle)->display)); 7630 } 7631 7632 case XCALL_ProtocolVersion: 7633 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7634 return Make_arbitrary_precision(taskData, ProtocolVersion(DEREFDISPLAYHANDLE(dsHandle)->display)); 7635 } 7636 7637 case XCALL_ServerVendor: 7638 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7639 return Make_string (ServerVendor(DEREFDISPLAYHANDLE(dsHandle)->display)); 7640 } 7641 7642 case XCALL_VendorRelease: 7643 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7644 return Make_arbitrary_precision(taskData, VendorRelease(DEREFDISPLAYHANDLE(dsHandle)->display)); 7645 } 7646 7647 /* Drawing Primitives 300 */ 7648 case XCALL_XClearArea: 7649 XClearArea(GetDisplay(taskData, XP1), 7650 GetWindow(taskData, XP1), 7651 GetRectX(taskData, P2), 7652 GetRectY(taskData, P2), 7653 GetRectW(taskData, P2), 7654 GetRectH(taskData, P2), 7655 get_C_ulong(taskData, P3)); 7656 break; 7657 7658 case XCALL_XClearWindow: 7659 XClearWindow(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 7660 break; 7661 7662 case XCALL_XCopyArea: 7663 XCopyArea(GetDisplay(taskData, XP1), 7664 GetDrawable(taskData, XP1), 7665 GetDrawable(taskData, XP2), 7666 GetGC(taskData, XP3), 7667 GetPointX(taskData, P4), 7668 GetPointY(taskData, P4), 7669 GetRectW(taskData, P5), 7670 GetRectH(taskData, P5), 7671 GetRectX(taskData, P5), 7672 GetRectY(taskData, P5)); 7673 break; 7674 7675 case XCALL_XCopyPlane: 7676 XCopyPlane(GetDisplay(taskData, XP1), 7677 GetDrawable(taskData, XP1), 7678 GetDrawable(taskData, XP2), 7679 GetGC(taskData, XP3), 7680 GetPointX(taskData, P4), 7681 GetPointY(taskData, P4), 7682 GetRectW(taskData, P5), 7683 GetRectH(taskData, P5), 7684 GetRectX(taskData, P5), 7685 GetRectY(taskData, P5), 7686 get_C_ulong(taskData, P6)); 7687 break; 7688 7689 case XCALL_XDrawArc: 7690 XDrawArc(GetDisplay(taskData, XP1), 7691 GetDrawable(taskData, XP1), 7692 GetGC(taskData, XP2), 7693 GetRectX(taskData, GetArcR(P3)), 7694 GetRectY(taskData, GetArcR(P3)), 7695 GetRectW(taskData, GetArcR(P3)), 7696 GetRectH(taskData, GetArcR(P3)), 7697 GetArcA1(taskData, P3), 7698 GetArcA2(taskData, P3)); 7699 break; 7700 7701 case XCALL_XDrawArcs: 7702 { 7703 Handle list = SAVE(P3); 7704 if (NONNIL(DEREFWORD(list))) 7705 { 7706 unsigned N = ListLength(DEREFWORD(list)); 7707 XArc *L = (XArc *)alloca(N * sizeof(XArc)); 7708 GetList4(taskData, DEREFWORD(list), L, sizeof(XArc), GetArcs); 7709 XDrawArcs(GetDisplay(taskData, XP1), GetDrawable(taskData, XP1), GetGC(taskData, XP2), L, N); 7710 } 7711 } 7712 break; 7713 7714 case XCALL_XDrawImageString: 7715 XDrawImageString(GetDisplay(taskData, XP1), 7716 GetDrawable(taskData, XP1), 7717 GetGC(taskData, XP2), 7718 GetPointX(taskData, P3), 7719 GetPointY(taskData, P3), 7720 GetString(P4)->chars, 7721 GetString(P4)->length); 7722 break; 7723 7724 case XCALL_XDrawImageString16: 7725 { 7726 Handle list = SAVE(P4); 7727 if (NONNIL(DEREFWORD(list))) 7728 { 7729 unsigned N = ListLength(DEREFWORD(list)); 7730 XChar2b *L = (XChar2b *)alloca(N * sizeof(XChar2b)); 7731 GetList4(taskData, DEREFWORD(list),L, sizeof(XChar2b), GetChar2); 7732 XDrawImageString16(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),GetPointX(taskData, P3),GetPointY(taskData, P3),L,N); 7733 } 7734 } 7735 break; 7736 7737 case XCALL_XDrawLine: 7738 XDrawLine(GetDisplay(taskData, XP1), GetDrawable(taskData, XP1), GetGC(taskData, XP2), GetPointX(taskData, P3), GetPointY(taskData, P3), 7739 GetPointX(taskData, P4), GetPointY(taskData, P4)); 7740 break; 7741 7742 case XCALL_XDrawLines: 7743 { 7744 Handle list = SAVE(P3); 7745 if (NONNIL(DEREFWORD(list))) 7746 { 7747 unsigned N = ListLength(DEREFWORD(list)); 7748 XPoint *L = (XPoint *)alloca(N * sizeof(XPoint)); 7749 GetList4(taskData, DEREFWORD(list), L, sizeof(XPoint), GetPoints); 7750 XDrawLines(GetDisplay(taskData, XP1), GetDrawable(taskData, XP1), GetGC(taskData, XP2), L, N, get_C_ulong(taskData, P4)); 7751 } 7752 } 7753 break; 7754 7755 case XCALL_XDrawPoint: 7756 XDrawPoint(GetDisplay(taskData, XP1), 7757 GetDrawable(taskData, XP1), 7758 GetGC(taskData, XP2), 7759 GetPointX(taskData, P3), 7760 GetPointY(taskData, P3)); 7761 break; 7762 7763 case XCALL_XDrawPoints: 7764 { 7765 Handle list = SAVE(P3); 7766 if (NONNIL(DEREFWORD(list))) 7767 { 7768 unsigned N = ListLength(DEREFWORD(list)); 7769 XPoint *L = (XPoint *)alloca(N * sizeof(XPoint)); 7770 GetList4(taskData, DEREFWORD(list),L,sizeof(XPoint),GetPoints); 7771 XDrawPoints(GetDisplay(taskData, XP1), GetDrawable(taskData, XP1), GetGC(taskData, XP2), L, N, get_C_ulong(taskData, P4)); 7772 } 7773 } 7774 break; 7775 7776 case XCALL_XDrawRectangle: 7777 XDrawRectangle(GetDisplay(taskData, XP1), 7778 GetDrawable(taskData, XP1), 7779 GetGC(taskData, XP2), 7780 GetRectX(taskData, P3), 7781 GetRectY(taskData, P3), 7782 GetRectW(taskData, P3), 7783 GetRectH(taskData, P3)); 7784 break; 7785 7786 case XCALL_XDrawRectangles: 7787 { 7788 Handle list = SAVE(P3); 7789 if (NONNIL(DEREFWORD(list))) 7790 { 7791 unsigned N = ListLength(DEREFWORD(list)); 7792 XRectangle *L = (XRectangle *)alloca(N * sizeof(XRectangle)); 7793 GetList4(taskData, DEREFWORD(list),L,sizeof(XRectangle),GetRects); 7794 XDrawRectangles(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),L,N); 7795 } 7796 } 7797 break; 7798 7799 case XCALL_XDrawSegments: 7800 { 7801 Handle list = SAVE(P3); 7802 if (NONNIL(DEREFWORD(list))) 7803 { 7804 unsigned N = ListLength(DEREFWORD(list)); 7805 XSegment *L = (XSegment *)alloca(N * sizeof(XSegment)); 7806 GetList4(taskData, DEREFWORD(list),L,sizeof(XSegment),GetSegments); 7807 XDrawSegments(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),L,N); 7808 } 7809 } 7810 break; 7811 7812 case XCALL_XDrawString: 7813 XDrawString(GetDisplay(taskData, XP1), 7814 GetDrawable(taskData, XP1), 7815 GetGC(taskData, XP2), 7816 GetPointX(taskData, P3), 7817 GetPointY(taskData, P3), 7818 GetString(P4)->chars, 7819 GetString(P4)->length); 7820 break; 7821 7822 case XCALL_XDrawString16: 7823 { 7824 Handle list = SAVE(P4); 7825 if (NONNIL(DEREFWORD(list))) 7826 { 7827 unsigned N = ListLength(DEREFWORD(list)); 7828 XChar2b *L = (XChar2b *)alloca(N * sizeof(XChar2b)); 7829 7830 GetList4(taskData, DEREFWORD(list),L,sizeof(XChar2b),GetChar2); 7831 7832 XDrawString16(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),GetPointX(taskData, P3),GetPointY(taskData, P3),L,N); 7833 } 7834 } 7835 break; 7836 7837 case XCALL_XDrawText: 7838 { 7839 Handle list = SAVE(P4); 7840 if (NONNIL(DEREFWORD(list))) 7841 { 7842 unsigned N = ListLength(DEREFWORD(list)); 7843 XTextItem *L = (XTextItem *)alloca(N * sizeof(XTextItem)); 7844 7845 GetList4(taskData, DEREFWORD(list),L,sizeof(XTextItem),GetText); 7846 XDrawText(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),GetPointX(taskData, P3),GetPointY(taskData, P3),L,N); 7847 7848 while (N--) { free(L->chars); L++; } 7849 } 7850 } 7851 break; 7852 7853 case XCALL_XDrawText16: 7854 { 7855 Handle list = SAVE(P4); 7856 if (NONNIL(DEREFWORD(list))) 7857 { 7858 unsigned N = ListLength(DEREFWORD(list)); 7859 XTextItem16 *L = (XTextItem16 *)alloca(N * sizeof(XTextItem16)); 7860 GetList4(taskData, DEREFWORD(list),L,sizeof(XTextItem16), GetText16); 7861 XDrawText16(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),GetPointX(taskData, P3),GetPointY(taskData, P3),L,N); 7862 7863 while (N--) { free(L->chars); L++; } 7864 } 7865 } 7866 break; 7867 7868 case XCALL_XFillArc: 7869 XFillArc(GetDisplay(taskData, XP1), 7870 GetDrawable(taskData, XP1), 7871 GetGC(taskData, XP2), 7872 GetRectX(taskData, GetArcR(P3)), 7873 GetRectY(taskData, GetArcR(P3)), 7874 GetRectW(taskData, GetArcR(P3)), 7875 GetRectH(taskData, GetArcR(P3)), 7876 GetArcA1(taskData, P3), 7877 GetArcA2(taskData, P3)); 7878 break; 7879 7880 case XCALL_XFillArcs: 7881 { 7882 Handle list = SAVE(P3); 7883 if (NONNIL(DEREFWORD(list))) 7884 { 7885 unsigned N = ListLength(DEREFWORD(list)); 7886 XArc *L = (XArc *)alloca(N * sizeof(XArc)); 7887 7888 GetList4(taskData, DEREFWORD(list),L,sizeof(XArc),GetArcs); 7889 7890 XFillArcs(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),L,N); 7891 } 7892 } 7893 break; 7894 7895 case XCALL_XFillPolygon: 7896 { 7897 Handle list = SAVE(P3); 7898 if (NONNIL(DEREFWORD(list))) 7899 { 7900 unsigned N = ListLength(DEREFWORD(list)); 7901 XPoint *L = (XPoint *)alloca(N * sizeof(XPoint)); 7902 7903 GetList4(taskData, DEREFWORD(list),L,sizeof(XPoint),GetPoints); 7904 7905 XFillPolygon(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),L,N,get_C_ulong(taskData, P4),get_C_ulong(taskData, P5)); 7906 } 7907 } 7908 break; 7909 7910 case XCALL_XFillRectangle: 7911 XFillRectangle(GetDisplay(taskData, XP1), 7912 GetDrawable(taskData, XP1), 7913 GetGC(taskData, XP2), 7914 GetRectX(taskData, P3), 7915 GetRectY(taskData, P3), 7916 GetRectW(taskData, P3), 7917 GetRectH(taskData, P3)); 7918 break; 7919 7920 case XCALL_XFillRectangles: 7921 { 7922 Handle list = SAVE(P3); 7923 if (NONNIL(DEREFWORD(list))) 7924 { 7925 unsigned N = ListLength(DEREFWORD(list)); 7926 XRectangle *L = (XRectangle *)alloca(N * sizeof(XRectangle)); 7927 GetList4(taskData, DEREFWORD(list),L,sizeof(XRectangle),GetRects); 7928 XFillRectangles(GetDisplay(taskData, XP1),GetDrawable(taskData, XP1),GetGC(taskData, XP2),L,N); 7929 } 7930 } 7931 break; 7932 7933 /* Events 350 */ 7934 7935 case XCALL_XSelectInput: 7936 (WindowObject(XP1))->eventMask->Set(0, PolyWord::FromUnsigned(get_C_ulong(taskData, P2))); 7937 XSelectInput(GetDisplay(taskData, XP1),GetWindow(taskData, XP1),XMASK((WindowObject(XP1))->eventMask->Get(0).AsUnsigned())); 7938 break; 7939 7940 case XCALL_XSynchronize: 7941 XSynchronize(GetDisplay(taskData, XP1),get_C_ulong(taskData, P2)); 7942 break; 7943 7944 case XCALL_GetState: 7945 return GetState(taskData, WindowObject(XP1)); /* WindowObject added SPF */ 7946 7947 case XCALL_SetState: 7948 SetState(WindowObject(XP1),P2,P3); /* WindowObject added SPF */ 7949 break; 7950 7951 case XCALL_NextEvent: 7952 return NextEvent(taskData, GetDS(taskData, XP1)); 7953 7954 case XCALL_InsertTimeout: 7955 InsertTimeout(taskData, WindowObject(XP1),get_C_ulong(taskData, P2),P3,P4); /* WindowObject added SPF */ 7956 break; 7957 7958 case XCALL_XSetInputFocus: 7959 XSetInputFocus(GetDisplay(taskData, XP1),GetWindow(taskData, XP2),get_C_ulong(taskData, P3),get_C_ulong(taskData, P4)); 7960 break; 7961 7962 case XCALL_XGetInputFocus: 7963 return GetInputFocus(taskData, GetDS(taskData, XP1)); 7964 7965 case XCALL_XSetSelectionOwner: 7966 SetSelectionOwner(GetDS(taskData, XP1),get_C_ulong(taskData, P2),GetWindow(taskData, XP3),get_C_ulong(taskData, P4)); 7967 break; 7968 7969 case XCALL_XGetSelectionOwner: 7970 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 7971 return EmptyWindow(taskData, dsHandle,XGetSelectionOwner(DEREFDISPLAYHANDLE(dsHandle)->display, 7972 get_C_ulong(taskData, P2))); 7973 } 7974 7975 case XCALL_XConvertSelection: 7976 XConvertSelection(GetDisplay(taskData, XP4), 7977 get_C_ulong(taskData, P1), 7978 get_C_ulong(taskData, P2), 7979 get_C_ulong(taskData, P3), 7980 GetWindow(taskData, XP4), 7981 get_C_ulong(taskData, P5)); 7982 break; 7983 7984 case XCALL_XSendSelectionNotify: 7985 SendSelectionNotify(GetDisplay(taskData, XP4), 7986 get_C_ulong(taskData, P1), 7987 get_C_ulong(taskData, P2), 7988 get_C_ulong(taskData, P3), 7989 GetWindow(taskData, XP4), 7990 get_C_ulong(taskData, P5)); 7991 break; 7992 7993 case XCALL_XDeleteProperty: 7994 XDeleteProperty(GetDisplay(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 7995 break; 7996 7997 case XCALL_XInternAtom: 7998 return InternAtom(taskData, GetDisplay(taskData, XP1),GetString(P2),get_C_long(taskData, P3)); 7999 8000 case XCALL_XGetAtomName: 8001 return GetAtomName(taskData, GetDisplay(taskData, XP1),get_C_ulong(taskData, P2)); 8002 8003 /* Fonts 400 */ 8004 8005 case XCALL_XGetFontPath: 8006 return GetFontPath(taskData, GetDisplay(taskData, XP1)); 8007 8008 case XCALL_XListFonts: 8009 return ListFonts(taskData, GetDisplay(taskData, XP1),GetString(P2),get_C_ulong(taskData, P3)); 8010 8011 case XCALL_XListFontsWithInfo: 8012 return ListFontsWithInfo(taskData, GetDS(taskData, XP1),GetString(P2),get_C_ulong(taskData, P3)); 8013 8014 case XCALL_XLoadFont: 8015 return LoadFont(taskData, GetDS(taskData, XP1),GetString(P2)); 8016 8017 case XCALL_XLoadQueryFont: 8018 return LoadQueryFont(taskData, GetDS(taskData, XP1),GetString(P2)); 8019 8020 case XCALL_XQueryFont: 8021 return QueryFont(taskData, GetDS(taskData, XP1),GetFont(taskData, XP1)); 8022 8023 case XCALL_XSetFontPath: 8024 SetFontPath(taskData, GetDisplay(taskData, XP1),SAVE(P2)); 8025 break; 8026 8027 /* Grabbing 450 */ 8028 8029 /* Graphics Context 500 */ 8030 8031 case XCALL_DefaultGC: 8032 return GetDefaultGC(taskData, GetDS(taskData, XP1)); 8033 8034 case XCALL_UpdateGC: 8035 ChangeGC(taskData, GCObject(XP1),get_C_ulong(taskData, P2),P3); 8036 break; 8037 8038 case XCALL_XCreateGC: 8039 return CreateGC(taskData, GetDS(taskData, XP1),GetDrawable(taskData, XP1)); 8040 8041 case XCALL_XSetClipRectangles: 8042 SetClipRectangles(taskData, GetDisplay(taskData, XP1), 8043 GetGC(taskData, XP1), 8044 GetPointX(taskData, P2), 8045 GetPointY(taskData, P2), 8046 SAVE(P3), 8047 get_C_ulong(taskData, P4)); 8048 break; 8049 8050 case XCALL_XSetDashes: 8051 SetDashes(taskData, GetDisplay(taskData, XP1), 8052 GetGC(taskData, XP1), 8053 get_C_ulong(taskData, P2), 8054 SAVE(P3)); 8055 break; 8056 8057 /* Images 550 */ 8058 8059 case XCALL_XAddPixel: 8060 AddPixel(GetXImage(taskData, GetDisplay(taskData, XP1),P2),get_C_ulong(taskData, P3)); 8061 break; 8062 8063 case XCALL_XGetImage: 8064 return GetImage(taskData, GetDisplay(taskData, XP1), 8065 GetDrawable(taskData, XP1), 8066 GetRectX(taskData, P2), 8067 GetRectY(taskData, P2), 8068 GetRectW(taskData, P2), 8069 GetRectH(taskData, P2), 8070 get_C_ulong(taskData, P3), 8071 get_C_long(taskData, P4)); 8072 8073 case XCALL_XGetPixel: 8074 return GetPixel(taskData, GetXImage(taskData, GetDisplay(taskData, XP1),P2), 8075 GetPointX(taskData, P3), 8076 GetPointY(taskData, P3)); 8077 8078 case XCALL_XGetSubImage: 8079 GetSubImage(GetDisplay(taskData, XP1), 8080 GetDrawable(taskData, XP1), 8081 GetRectX(taskData, P2), 8082 GetRectY(taskData, P2), 8083 GetRectW(taskData, P2), 8084 GetRectH(taskData, P2), 8085 get_C_ulong(taskData, P3), 8086 get_C_long(taskData, P4), 8087 GetXImage(taskData, GetDisplay(taskData, XP1),P5), 8088 GetPointX(taskData, P6), 8089 GetPointY(taskData, P6)); 8090 break; 8091 8092 case XCALL_XPutImage: 8093 PutImage(GetDisplay(taskData, XP1), 8094 GetDrawable(taskData, XP1), 8095 GetGC(taskData, XP2), 8096 GetXImage(taskData, GetDisplay(taskData, XP1),P3), 8097 GetPointX(taskData, P4), 8098 GetPointY(taskData, P4), 8099 GetRectX(taskData, P5), 8100 GetRectY(taskData, P5), 8101 GetRectW(taskData, P5), 8102 GetRectH(taskData, P5)); 8103 break; 8104 8105 case XCALL_XPutPixel: 8106 PutPixel(GetXImage(taskData, GetDisplay(taskData, XP1),P2), 8107 GetPointX(taskData, P3), 8108 GetPointY(taskData, P3), 8109 get_C_ulong(taskData, P4)); 8110 break; 8111 8112 case XCALL_XSubImage: 8113 return SubImage(taskData, GetXImage(taskData, GetDisplay(taskData, XP1),P2), 8114 GetRectX(taskData, P3), 8115 GetRectY(taskData, P3), 8116 GetRectW(taskData, P3), 8117 GetRectH(taskData, P3)); 8118 8119 case XCALL_BitmapBitOrder: 8120 return Make_arbitrary_precision(taskData, MLImageOrder(BitmapBitOrder(GetDisplay(taskData, XP1)))); 8121 8122 case XCALL_BitmapPad: 8123 return Make_arbitrary_precision(taskData, BitmapPad(GetDisplay(taskData, XP1))); 8124 8125 case XCALL_BitmapUnit: 8126 return Make_arbitrary_precision(taskData, BitmapUnit(GetDisplay(taskData, XP1))); 8127 8128 case XCALL_ByteOrder: 8129 return Make_arbitrary_precision(taskData, MLImageOrder(ImageByteOrder(GetDisplay(taskData, XP1)))); 8130 8131 /* Keyboard 600 */ 8132 case XCALL_XLookupString: 8133 return LookupString(taskData, GetDisplay(taskData, XP1),get_C_ulong(taskData, P2),get_C_ulong(taskData, P3)); 8134 8135 case XCALL_XQueryKeymap: 8136 return QueryKeymap(taskData, GetDisplay(taskData, XP1)); 8137 8138 case XCALL_IsCursorKey: 8139 return Make_bool(IsCursorKey(get_C_ulong(taskData, P1))); 8140 8141 case XCALL_IsFunctionKey: 8142 return Make_bool(IsFunctionKey(get_C_ulong(taskData, P1))); 8143 8144 case XCALL_IsKeypadKey: 8145 return Make_bool(IsKeypadKey(get_C_ulong(taskData, P1))); 8146 8147 case XCALL_IsMiscFunctionKey: 8148 return Make_bool(IsMiscFunctionKey(get_C_ulong(taskData, P1))); 8149 8150 case XCALL_IsModifierKey: 8151 return Make_bool(IsModifierKey(get_C_ulong(taskData, P1))); 8152 8153 case XCALL_IsPFKey: 8154 return Make_bool(IsPFKey(get_C_ulong(taskData, P1))); 8155 8156 /* Output Buffer 650 */ 8157 case XCALL_XFlush: 8158 XFlush(GetDisplay(taskData, XP1)); 8159 break; 8160 8161 case XCALL_XSync: 8162 XSync(GetDisplay(taskData, XP1),get_C_ulong(taskData, P2)); 8163 break; 8164 8165 /* Pointers 700 */ 8166 case XCALL_XQueryPointer: 8167 return QueryPointer(taskData, GetDS(taskData, XP1),GetWindow(taskData, XP1)); 8168 8169 /* Regions 750*/ 8170 8171 /* SAVE Set 800 */ 8172 8173 /* Screen Saver 850 */ 8174 case XCALL_XActivateScreenSaver: 8175 XActivateScreenSaver(GetDisplay(taskData, XP1)); 8176 break; 8177 8178 case XCALL_XForceScreenSaver: 8179 XForceScreenSaver(GetDisplay(taskData, XP1),get_C_ulong(taskData, P2)); 8180 break; 8181 8182 case XCALL_XGetScreenSaver: 8183 return GetScreenSaver(taskData, GetDisplay(taskData, XP1)); 8184 8185 case XCALL_XResetScreenSaver: 8186 XResetScreenSaver(GetDisplay(taskData, XP1)); 8187 break; 8188 8189 case XCALL_XSetScreenSaver: 8190 XSetScreenSaver(GetDisplay(taskData, XP1), 8191 get_C_long(taskData, P2), 8192 get_C_long(taskData, P3), 8193 get_C_ulong(taskData, P4), 8194 get_C_ulong(taskData, P5)); 8195 break; 8196 8197 /* Standard Geometry 900 */ 8198 case XCALL_XTranslateCoordinates: 8199 return TranslateCoordinates(taskData, GetDS(taskData, XP1), 8200 GetWindow(taskData, XP1), 8201 GetWindow(taskData, XP2), 8202 GetPointX(taskData, P3), 8203 GetPointY(taskData, P3)); 8204 8205 /* Text 950 */ 8206 case XCALL_XTextExtents: 8207 return TextExtents(taskData, GetFontStruct(taskData, P1),GetString(P2)); 8208 8209 case XCALL_XTextExtents16: 8210 return TextExtents16(taskData, GetFontStruct(taskData, P1),SAVE(P2)); 8211 8212 case XCALL_XTextWidth: 8213 return TextWidth(taskData, GetFontStruct(taskData, P1),GetString(P2)); 8214 8215 case XCALL_XTextWidth16: 8216 return TextWidth16(taskData, GetFontStruct(taskData, P1),SAVE(P2)); 8217 8218 /* Tiles, Pixmaps, Stipples and Bitmaps 1000 */ 8219 case XCALL_XCreateBitmapFromData: 8220 { 8221 Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 8222 CheckZeroRect(taskData, P3); 8223 return EmptyPixmap(taskData, dsHandle, 8224 XCreateBitmapFromData( 8225 DEREFDISPLAYHANDLE(dsHandle)->display, 8226 GetDrawable(taskData, XP1), /* drawable */ 8227 GetString(P2)->chars, /* data */ 8228 GetRectW(taskData, P3), /* width */ 8229 GetRectH(taskData, P3))); /* height */ 8230 } 8231 8232 case XCALL_XCreatePixmap: 8233 { 8234 Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 8235 CheckZeroRect(taskData, P2); 8236 return EmptyPixmap(taskData, dsHandle, 8237 XCreatePixmap( 8238 DEREFDISPLAYHANDLE(dsHandle)->display, 8239 GetDrawable(taskData, XP1), /* drawable */ 8240 GetRectW(taskData, P2), /* width */ 8241 GetRectH(taskData, P2), /* height */ 8242 get_C_ulong(taskData, P3))); /* depth */ 8243 } 8244 8245 case XCALL_XCreatePixmapFromBitmapData: 8246 { 8247 Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 8248 CheckZeroRect(taskData, P3); 8249 8250 return EmptyPixmap(taskData, dsHandle, 8251 XCreatePixmapFromBitmapData( 8252 DEREFDISPLAYHANDLE(dsHandle)->display, 8253 GetDrawable(taskData, XP1), /* drawable */ 8254 GetString(P2)->chars, /* data */ 8255 GetRectW(taskData, P3), /* width */ 8256 GetRectH(taskData, P3), /* height */ 8257 get_C_ulong(taskData, P4), /* foreground */ 8258 get_C_ulong(taskData, P5), /* background */ 8259 get_C_ulong(taskData, P6))); /* depth */ 8260 } 8261 8262 case XCALL_XQueryBestStipple: 8263 CheckZeroRect(taskData, P2); 8264 return QueryBest(taskData, XQueryBestStipple, 8265 GetDisplay(taskData, XP1), 8266 GetDrawable(taskData, XP1), 8267 GetRectW(taskData, P2), 8268 GetRectH(taskData, P2)); 8269 8270 case XCALL_XQueryBestTile: 8271 CheckZeroRect(taskData, P2); 8272 return QueryBest(taskData, XQueryBestTile, 8273 GetDisplay(taskData, XP1), 8274 GetDrawable(taskData, XP1), 8275 GetRectW(taskData, P2), 8276 GetRectH(taskData, P2)); 8277 8278 case XCALL_XReadBitmapFile: 8279 return ReadBitmap(taskData, GetDS(taskData, XP1),GetDrawable(taskData, XP1),GetString(P2)); 8280 8281 case XCALL_XWriteBitmapFile: 8282 CheckZeroRect(taskData, P3); 8283 return WriteBitmapFile(taskData, GetString(XP1), 8284 GetDisplay(taskData, XP2), 8285 GetPixmap(taskData, XP2), 8286 GetRectW(taskData, P3), 8287 GetRectH(taskData, P3), 8288 GetPointX(taskData, P4), 8289 GetPointY(taskData, P4)); 8290 8291 /* User Preferences 1050 */ 8292 case XCALL_XAutoRepeatOff: 8293 XAutoRepeatOff(GetDisplay(taskData, XP1)); 8294 break; 8295 8296 case XCALL_XAutoRepeatOn: 8297 XAutoRepeatOn (GetDisplay(taskData, XP1)); 8298 break; 8299 8300 case XCALL_XBell: 8301 XBell(GetDisplay(taskData, XP1),get_C_short(taskData, P2)); 8302 break; 8303 8304 case XCALL_XGetDefault: 8305 return GetDefault(taskData, GetDisplay(taskData, XP1),GetString(P2),GetString(P3)); 8306 8307 /* Window Attributes 1100 */ 8308 case XCALL_ChangeWindow: 8309 ChangeWindowAttributes(taskData, WindowObject(XP1),get_C_ulong(taskData, P2),P3); 8310 break; 8311 8312 case XCALL_XGetGeometry: 8313 return GetGeometry(taskData, GetDS(taskData, XP1),GetDrawable(taskData, XP1)); 8314 8315 case XCALL_XGetWindowAttributes: 8316 return GetWindowAttributes(taskData, GetDS(taskData, XP1),GetDrawable(taskData, XP1)); 8317 8318 case XCALL_XSetWindowBorderWidth: 8319 XSetWindowBorderWidth(GetDisplay(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 8320 break; 8321 8322 /* Window Configuration 1150 */ 8323 case XCALL_XCirculateSubwindows: 8324 XCirculateSubwindows(GetDisplay(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 8325 break; 8326 8327 case XCALL_XConfigureWindow: 8328 ConfigureWindow(taskData, GetDisplay(taskData, XP1),GetWindow(taskData, XP1), P2); 8329 break; 8330 8331 case XCALL_XLowerWindow: 8332 XLowerWindow(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8333 break; 8334 8335 case XCALL_XMapRaised: 8336 XMapRaised(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8337 break; 8338 8339 case XCALL_XMapSubwindows: 8340 XMapSubwindows(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8341 break; 8342 8343 case XCALL_XMapWindow: 8344 XMapWindow(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8345 break; 8346 8347 case XCALL_XMoveResizeWindow: 8348 CheckZeroRect(taskData, P3); 8349 XMoveResizeWindow(GetDisplay(taskData, XP1), 8350 GetWindow(taskData, XP1), 8351 GetPointX(taskData, P2), 8352 GetPointY(taskData, P2), 8353 GetRectW(taskData, P3), 8354 GetRectH(taskData, P3)); 8355 break; 8356 8357 case XCALL_XMoveWindow: 8358 XMoveWindow(GetDisplay(taskData, XP1), 8359 GetWindow(taskData, XP1), 8360 GetPointX(taskData, P2), 8361 GetPointY(taskData, P2)); 8362 break; 8363 8364 case XCALL_XQueryTree: 8365 return QueryTree(taskData,GetDS(taskData, XP1),GetWindow(taskData, XP1)); 8366 8367 case XCALL_XRaiseWindow: 8368 XRaiseWindow(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8369 break; 8370 8371 case XCALL_XReparentWindow: 8372 XReparentWindow(GetDisplay(taskData, XP1), 8373 GetWindow(taskData, XP1), 8374 GetWindow(taskData, XP2), 8375 GetPointX(taskData, P3), 8376 GetPointY(taskData, P3)); 8377 break; 8378 8379 case XCALL_XResizeWindow: 8380 CheckZeroRect(taskData, P2); 8381 XResizeWindow(GetDisplay(taskData, XP1), 8382 GetWindow(taskData, XP1), 8383 GetRectW(taskData, P2), 8384 GetRectH(taskData, P2)); 8385 break; 8386 8387 case XCALL_XRestackWindows: 8388 RestackWindows(taskData, SAVE(P1)); 8389 break; 8390 8391 case XCALL_XUnmapSubwindows: 8392 XUnmapSubwindows(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8393 break; 8394 8395 case XCALL_XUnmapWindow: 8396 XUnmapWindow(GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8397 break; 8398 8399 /* Window Existence 1200 */ 8400 case XCALL_RootWindow: 8401 { Handle dsHandle /* Handle to (X_Display_Object *) */ = GetDS(taskData, XP1); 8402 return EmptyWindow(taskData, dsHandle, 8403 RootWindow(DEREFDISPLAYHANDLE(dsHandle)->display, 8404 DEREFDISPLAYHANDLE(dsHandle)->screen)); 8405 } 8406 8407 case XCALL_DestroyXObject: 8408 DestroyXObject(XP1); 8409 break; 8410 8411 case XCALL_XDestroySubwindows: 8412 DestroySubwindows(XP1); 8413 break; 8414 8415 case XCALL_XCreateSimpleWindow: 8416 CheckZeroRect(taskData, P3); 8417 return CreateSimpleWindow(taskData, 8418 SAVE(XP1), /* parent */ 8419 GetPointX(taskData, P2), /* x */ 8420 GetPointY(taskData, P2), /* y */ 8421 GetRectW(taskData, P3), /* w */ 8422 GetRectH(taskData, P3), /* h */ 8423 get_C_ulong(taskData, P4), /* borderWidth */ 8424 get_C_ulong(taskData, P5), /* border */ 8425 get_C_ulong(taskData, P6), /* background */ 8426 SAVE(P7), /* handler */ 8427 SAVE(P8)); /* state */ 8428 8429 case XCALL_XCreateWindow: 8430 CheckZeroRect(taskData, P3); 8431 return CreateWindow(taskData, 8432 SAVE(XP1), /* parent */ 8433 GetPointX(taskData, P2), /* x */ 8434 GetPointY(taskData, P2), /* y */ 8435 GetRectW(taskData, P3), /* w */ 8436 GetRectH(taskData, P3), /* h */ 8437 get_C_ulong(taskData, P4), /* borderWidth */ 8438 get_C_ulong(taskData, P5), /* depth */ 8439 get_C_ulong(taskData, P6), /* class */ 8440 GetVisual(taskData, XP7), /* visual */ 8441 SAVE(P8), /* handler */ 8442 SAVE(P9)); /* state */ 8443 8444 /* Window Manager 1250 */ 8445 case XCALL_XSetProperty: 8446 SetProperty(taskData, GetDisplay(taskData, XP1), 8447 GetWindow(taskData, XP1), 8448 get_C_ulong(taskData, P2), 8449 get_C_ulong(taskData, P3), 8450 SAVE(P4), 8451 get_C_ulong(taskData, P5)); 8452 break; 8453 8454 case XCALL_XGetTextProperty: 8455 return GetTextProperty(taskData, GetDisplay(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 8456 8457 case XCALL_XGetWMHints: 8458 return GetWMHints(taskData, GetDS(taskData, XP1),GetWindow(taskData, XP1)); 8459 8460 case XCALL_XGetWMSizeHints: 8461 return GetWMSizeHints(taskData, GetDisplay(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 8462 8463 case XCALL_XGetIconSizes: 8464 return GetIconSizes(taskData, GetDisplay(taskData, XP1),GetWindow(taskData, XP1)); 8465 8466 case XCALL_XGetTransientForHint: 8467 return GetTransientForHint(taskData, GetDS(taskData, XP1),GetWindow(taskData, XP1)); 8468 8469 case XCALL_XGetWMColormapWindows: 8470 return GetWMColormapWindows(taskData, GetDS(taskData, XP1),GetWindow(taskData, XP1)); 8471 8472 case XCALL_XGetRGBColormaps: 8473 return GetRGBColormaps(taskData, GetDS(taskData, XP1),GetWindow(taskData, XP1),get_C_ulong(taskData, P2)); 8474 8475 case XCALL_XWMGeometry: 8476 return WMGeometry(taskData, GetDS(taskData, XP1), 8477 GetString(P2), 8478 GetString(P3), 8479 get_C_ulong(taskData, P4), 8480 P5); 8481 8482 /* Miscellaneous 1300 */ 8483 case XCALL_GetID: 8484 return GetID(taskData, XP1); 8485 8486 case XCALL_ResourceExists: 8487 return Make_bool(ResourceExists(XP1)); 8488 8489 case XCALL_GetDisplay: 8490 return GetDS(taskData, XP1); 8491 8492 /******************************************************************************/ 8493 /* */ 8494 /* Xt Calls */ 8495 /* */ 8496 /******************************************************************************/ 8497 case XCALL_NoWidget: 8498 return EmptyWidget(taskData, SAVE(ListNull), (Widget)NULL); 8499 8500 case XCALL_AppInitialise: 8501 return AppInitialise(taskData, P1, /* display name */ 8502 P2, /* application name */ 8503 P3, /* application class */ 8504 SAVE(P4), /* Fallback list */ 8505 SAVE(P5) /* Arg list */); 8506 8507 case XCALL_XtRealizeWidget: 8508 XtRealizeWidget(GetWidget(taskData, XP1)); 8509 break; 8510 8511 case XCALL_XtManageChildren: 8512 ManageChildren(taskData, SAVE(P1)); 8513 break; 8514 8515 case XCALL_XtUnmanageChildren: 8516 UnmanageChildren(taskData, SAVE(P1)); 8517 break; 8518 8519 case XCALL_XtDestroyWidget: 8520 { 8521 Widget w = GetWidget(taskData, XP1); 8522 XtDestroyWidget(w); 8523 /* The following test seems necessary - sometimes the callback from */ 8524 /* the above call destroys the widget, sometimes it doesn't. I think */ 8525 /* it always should, and I can't work out why this strange behaviour */ 8526 /* occurs. SPF 9/12/93 */ 8527 if (ResourceExists(XP1)) 8528 { 8529 DestroyXObject(XP1); 8530 PurgeCCallbacks((X_Widget_Object *)XP1,w); 8531 } 8532 break; 8533 } 8534 8535 case XCALL_SetCallbacks: 8536 SetCallbacks (taskData, WidgetObject(taskData, XP1),P2,P3); 8537 break; /* WidgetObject added SPF */ 8538 8539 case XCALL_XtSetValues: 8540 SetValues(taskData, GetWidget(taskData, XP1),SAVE(P2)); 8541 break; 8542 8543 case XCALL_GetValue: 8544 return GetValue(taskData, GetDS(taskData, XP1),GetWidget(taskData, XP1),P2); 8545 8546 case XCALL_XtParent: 8547 return EmptyWidget(taskData, GetDS(taskData, XP1),XtParent(GetWidget(taskData, XP1))); 8548 8549 case XCALL_XtWindow: 8550 return EmptyWindow(taskData, GetDS(taskData, XP1),WindowOfWidget(GetWidget(taskData, XP1))); 8551 8552 case XCALL_XtDisplay: 8553 return GetDS(taskData, XP1); 8554 8555 case XCALL_XtUnrealizeWidget: 8556 XtUnrealizeWidget(GetWidget(taskData, XP1)); break; 8557 8558 case XCALL_XtName: 8559 return Make_string(XtName(GetWidget(taskData, XP1))); 8560 8561 case XCALL_XtParseTranslationTable: 8562 return ParseTranslationTable(taskData, GetString(XP1)); 8563 8564 case XCALL_XtOverrideTranslations: 8565 XtOverrideTranslations(GetWidget(taskData, XP1),GetTrans(taskData, XP2)); 8566 break; 8567 8568 case XCALL_XtAugmentTranslations: 8569 XtAugmentTranslations(GetWidget(taskData, XP1),GetTrans(taskData, XP2)); 8570 break; 8571 8572 case XCALL_XtUninstallTranslations: XtUninstallTranslations(GetWidget(taskData, XP1)); break; 8573 8574 /* 8575 case XCALL_XtTranslateTablePrint: _XtTranslateTablePrint(GetTrans(taskData, XP1)); break; 8576 */ 8577 8578 case XCALL_XtCreatePopupShell: 8579 return CreatePopupShell(taskData, GetString(XP1),GetDS(taskData, XP2),GetWidget(taskData, XP2),SAVE(P3)); 8580 8581 case XCALL_InsertWidgetTimeout: 8582 InsertWidgetTimeout(taskData, WidgetObject(taskData, XP1),get_C_ulong(taskData, P2),P3,P4); 8583 break; /* WidgetObject added SPF */ 8584 8585 case XCALL_GetWidgetState: 8586 return SAVE(WidgetObjectToken(XP1)->state); /* was WidgetObject(XP1) (SPF) */ 8587 8588 case XCALL_SetWidgetState: 8589 WidgetObjectToken(XP1)->state = P2; 8590 break; /* was WidgetObject(XP1) (SPF) */ 8591 8592 case XCALL_XtSetSensitive: 8593 XtSetSensitive(GetWidget(taskData, XP1),get_C_ulong(taskData, P2)); 8594 break; 8595 8596 case XCALL_XtIsSensitive: 8597 return Make_bool(XtIsSensitive(GetWidget(taskData, XP1))); 8598 8599 case XCALL_GetSubresources: 8600 return GetSubresources(taskData, GetDS(taskData, XP1), 8601 GetWidget(taskData, XP1), 8602 GetString(P2), 8603 GetString(P3), 8604 SAVE(P4)); 8605 8606 case XCALL_Cast: 8607 return SAVE(P1); 8608 8609 case XCALL_XtPopup: 8610 XtPopup(GetWidget(taskData, XP1),GetXtGrabKind(taskData, P2)); 8611 break; 8612 8613 case XCALL_XtPopdown: 8614 XtPopdown(GetWidget(taskData, XP1)); 8615 break; 8616 8617 case XCALL_XtMapWidget: 8618 XtMapWidget(GetRealizedWidget(taskData, (char *) "XtMapWidget",XP1)); 8619 break; 8620 8621 case XCALL_XtUnmapWidget: 8622 XtUnmapWidget(GetRealizedWidget(taskData, (char *) "XtUnmapWidget",XP1)); 8623 break; 8624 8625 case XCALL_XtIsManaged: 8626 return Make_bool(XtIsManaged(GetWidget(taskData, XP1))); 8627 8628 case XCALL_XtIsRealized: 8629 return Make_bool(XtIsRealized(GetWidget(taskData, XP1))); 8630 8631 /* Added DCJM. */ 8632 case XCALL_XtGetApplicationResources: 8633 return GetApplicationResources (taskData, GetDS(taskData, XP1),GetWidget(taskData, XP1),SAVE(P2) ) ; 8634 8635 case XCALL_XtAddEventHandler: 8636 AddEventhandler (taskData, WidgetObject(taskData, XP1), get_C_ulong(taskData, P2), 8637 get_C_ulong(taskData, P3), SAVE(P4)); break; 8638 8639 8640 /******************************************************************************/ 8641 /* */ 8642 /* Motif Calls - widget creation */ 8643 /* */ 8644 /******************************************************************************/ 8645 /* Motif 4000 */ 8646 8647#define XMCREATE(number,name) \ 8648 case number: return CreateXm(taskData, name, (char *) \ 8649#name " failed", \ 8650 GetDS(taskData, XP1), \ 8651 GetWidget(taskData, XP1), \ 8652 GetString(P2), \ 8653 SAVE(P3)) 8654 8655 XMCREATE(XCALL_XmCreateArrowButton,XmCreateArrowButton); 8656 XMCREATE(XCALL_XmCreateArrowButtonGadget,XmCreateArrowButtonGadget); 8657 XMCREATE(XCALL_XmCreateBulletinBoard,XmCreateBulletinBoard); 8658 XMCREATE(XCALL_XmCreateBulletinBoardDialog,XmCreateBulletinBoardDialog); 8659 XMCREATE(XCALL_XmCreateCascadeButton,XmCreateCascadeButton); 8660 XMCREATE(XCALL_XmCreateCascadeButtonGadget,XmCreateCascadeButtonGadget); 8661 XMCREATE(XCALL_XmCreateCommand,XmCreateCommand); 8662 XMCREATE(XCALL_XmCreateDialogShell,XmCreateDialogShell); 8663 XMCREATE(XCALL_XmCreateDrawingArea,XmCreateDrawingArea); 8664 XMCREATE(XCALL_XmCreateDrawnButton,XmCreateDrawnButton); 8665 XMCREATE(XCALL_XmCreateErrorDialog,XmCreateErrorDialog); 8666 XMCREATE(XCALL_XmCreateFileSelectionBox,XmCreateFileSelectionBox); 8667 XMCREATE(XCALL_XmCreateFileSelectionDialog,XmCreateFileSelectionDialog); 8668 XMCREATE(XCALL_XmCreateForm,XmCreateForm); 8669 XMCREATE(XCALL_XmCreateFormDialog,XmCreateFormDialog); 8670 XMCREATE(XCALL_XmCreateFrame,XmCreateFrame); 8671 XMCREATE(XCALL_XmCreateInformationDialog,XmCreateInformationDialog); 8672 XMCREATE(XCALL_XmCreateLabel,XmCreateLabel); 8673 XMCREATE(XCALL_XmCreateLabelGadget,XmCreateLabelGadget); 8674 XMCREATE(XCALL_XmCreateList,XmCreateList); 8675 XMCREATE(XCALL_XmCreateMainWindow,XmCreateMainWindow); 8676 XMCREATE(XCALL_XmCreateMenuBar,XmCreateMenuBar); 8677 XMCREATE(XCALL_XmCreateMenuShell,XmCreateMenuShell); 8678 XMCREATE(XCALL_XmCreateMessageBox,XmCreateMessageBox); 8679 XMCREATE(XCALL_XmCreateMessageDialog,XmCreateMessageDialog); 8680 XMCREATE(XCALL_XmCreateOptionMenu,XmCreateOptionMenu); 8681 XMCREATE(XCALL_XmCreatePanedWindow,XmCreatePanedWindow); 8682 XMCREATE(XCALL_XmCreatePopupMenu,XmCreatePopupMenu); 8683 XMCREATE(XCALL_XmCreatePromptDialog,XmCreatePromptDialog); 8684 XMCREATE(XCALL_XmCreatePulldownMenu,XmCreatePulldownMenu); 8685 XMCREATE(XCALL_XmCreatePushButton,XmCreatePushButton); 8686 XMCREATE(XCALL_XmCreatePushButtonGadget,XmCreatePushButtonGadget); 8687 XMCREATE(XCALL_XmCreateQuestionDialog,XmCreateQuestionDialog); 8688 XMCREATE(XCALL_XmCreateRadioBox,XmCreateRadioBox); 8689 XMCREATE(XCALL_XmCreateRowColumn,XmCreateRowColumn); 8690 XMCREATE(XCALL_XmCreateScale,XmCreateScale); 8691 XMCREATE(XCALL_XmCreateScrollBar,XmCreateScrollBar); 8692 XMCREATE(XCALL_XmCreateScrolledList,XmCreateScrolledList); 8693 XMCREATE(XCALL_XmCreateScrolledText,XmCreateScrolledText); 8694 XMCREATE(XCALL_XmCreateScrolledWindow,XmCreateScrolledWindow); 8695 XMCREATE(XCALL_XmCreateSelectionBox,XmCreateSelectionBox); 8696 XMCREATE(XCALL_XmCreateSelectionDialog,XmCreateSelectionDialog); 8697 XMCREATE(XCALL_XmCreateSeparator,XmCreateSeparator); 8698 XMCREATE(XCALL_XmCreateSeparatorGadget,XmCreateSeparatorGadget); 8699 XMCREATE(XCALL_XmCreateSimpleCheckBox,XmCreateSimpleCheckBox); 8700 XMCREATE(XCALL_XmCreateSimpleMenuBar,XmCreateSimpleMenuBar); 8701 XMCREATE(XCALL_XmCreateSimpleOptionMenu,XmCreateSimpleOptionMenu); 8702 XMCREATE(XCALL_XmCreateSimplePopupMenu,XmCreateSimplePopupMenu); 8703 XMCREATE(XCALL_XmCreateSimplePulldownMenu,XmCreateSimplePulldownMenu); 8704 XMCREATE(XCALL_XmCreateSimpleRadioBox,XmCreateSimpleRadioBox); 8705 XMCREATE(XCALL_XmCreateText,XmCreateText); 8706 XMCREATE(XCALL_XmCreateTextField,XmCreateTextField); 8707 XMCREATE(XCALL_XmCreateToggleButton,XmCreateToggleButton); 8708 XMCREATE(XCALL_XmCreateToggleButtonGadget,XmCreateToggleButtonGadget); 8709 XMCREATE(XCALL_XmCreateWarningDialog,XmCreateWarningDialog); 8710 XMCREATE(XCALL_XmCreateWorkArea,XmCreateWorkArea); 8711 XMCREATE(XCALL_XmCreateWorkingDialog,XmCreateWorkingDialog); 8712 8713#undef XMCREATE 8714 8715 /******************************************************************************/ 8716 /* */ 8717 /* Motif Calls - miscellaneous */ 8718 /* */ 8719 /******************************************************************************/ 8720 case XCALL_XmCascadeButtonHighlight: 8721 XmCascadeButtonHighlight(GetWidget(taskData, XP1),get_C_ulong(taskData, P2)); 8722 break; 8723 8724 case XCALL_XmCommandError: 8725 CommandError(taskData, GetWidget(taskData, XP1),P2); 8726 break; 8727 8728 case XCALL_XmCommandGetChild: 8729 return EmptyWidget(taskData, GetDS(taskData, XP1), 8730 XmCommandGetChild(GetWidget(taskData, XP1),get_C_ulong(taskData, P2))); 8731 8732 case XCALL_XmFileSelectionBoxGetChild: 8733 return EmptyWidget(taskData, GetDS(taskData, XP1), 8734 XmFileSelectionBoxGetChild(GetWidget(taskData, XP1),get_C_ulong(taskData, P2))); 8735 8736 case XCALL_XmFileSelectionDoSearch: 8737 FileSelectionDoSearch(taskData, GetWidget(taskData, XP1),P2); 8738 break; 8739 8740 case XCALL_XmIsSomething: 8741 return XmIsSomething(taskData, get_C_ulong(taskData, P1),GetWidget(taskData, XP2)); 8742 8743 case XCALL_XmMainWindowSetAreas: 8744 XmMainWindowSetAreas(GetWidget(taskData, XP1), 8745 GetNWidget(taskData, XP2), 8746 GetNWidget(taskData, XP3), 8747 GetNWidget(taskData, XP4), 8748 GetNWidget(taskData, XP5), 8749 GetNWidget(taskData, XP6)); 8750 break; 8751 8752 case XCALL_XmMainWindowSepX: 8753 switch(get_C_ulong(taskData, P2)) 8754 { 8755 case 1: 8756 return EmptyWidget(taskData, GetDS(taskData, XP1),XmMainWindowSep1(GetWidget(taskData, XP1))); 8757 8758 case 2: 8759 return EmptyWidget(taskData, GetDS(taskData, XP1),XmMainWindowSep2(GetWidget(taskData, XP1))); 8760 8761 default: 8762 return EmptyWidget(taskData, GetDS(taskData, XP1),XmMainWindowSep3(GetWidget(taskData, XP1))); 8763 } 8764 8765 case XCALL_XmMessageBoxGetChild: 8766 return EmptyWidget(taskData, GetDS(taskData, XP1), 8767 XmMessageBoxGetChild(GetWidget(taskData, XP1),get_C_ulong(taskData, P2))); 8768 8769 case XCALL_XmOptionButtonGadget: 8770 return EmptyWidget(taskData, GetDS(taskData, XP1),XmOptionButtonGadget(GetWidget(taskData, XP1))); 8771 8772 case XCALL_XmOptionLabelGadget: 8773 return EmptyWidget(taskData, GetDS(taskData, XP1),XmOptionLabelGadget (GetWidget(taskData, XP1))); 8774 8775 case XCALL_XmSelectionBoxGetChild: 8776 return EmptyWidget(taskData, GetDS(taskData, XP1), 8777 XmSelectionBoxGetChild(GetWidget(taskData, XP1),get_C_ulong(taskData, P2))); 8778 8779 case XCALL_XmSetMenuCursor: 8780 XmSetMenuCursor(GetDisplay(taskData, XP1),GetCursor(taskData, XP2)); break; 8781 8782 case XCALL_XmScrolledWindowSetAreas: 8783 XmScrolledWindowSetAreas(GetWidget(taskData, XP1), 8784 GetNWidget(taskData, XP2), 8785 GetNWidget(taskData, XP3), 8786 GetNWidget(taskData, XP4)); 8787 break; 8788 8789 8790 /******************************************************************************/ 8791 /* */ 8792 /* Operations on XmText widgets */ 8793 /* */ 8794 /******************************************************************************/ 8795 8796#define TextWidgetToLong(func) \ 8797 case XCALL_ ## func : \ 8798 return(WidgetToLong(taskData,(char *) #func,GetTextWidget,func,XP1)) 8799 8800#define TextWidgetToInt(func) \ 8801 case XCALL_ ## func : \ 8802 return(WidgetToInt(taskData,(char *) #func,GetTextWidget,func,XP1)) 8803 8804#define TextWidgetToBool(func) \ 8805 case XCALL_ ## func : \ 8806 return(WidgetToBool(taskData,(char *) #func,GetTextWidget,func,XP1)) 8807 8808#define TextWidgetToString(func) \ 8809 case XCALL_ ## func : \ 8810 return(WidgetToString(taskData,(char *) #func,GetTextWidget,func,XP1)) 8811 8812#define TextWidgetIntAction(func) \ 8813 case XCALL_ ## func : \ 8814 WidgetIntAction(taskData,(char *) #func,GetTextWidget,func,XP1,P2); \ 8815 break 8816 8817#define TextWidgetLongAction(func) \ 8818 case XCALL_ ## func : \ 8819 WidgetLongAction(taskData,(char *) #func,GetTextWidget,func,XP1,P2); \ 8820 break 8821 8822#define TextWidgetBoolAction(func) \ 8823 case XCALL_ ## func : \ 8824 WidgetBoolAction(taskData,(char *) #func,GetTextWidget,func,XP1,P2); \ 8825 break 8826 8827 8828 /* XmTextClearSelection not supported */ 8829 /* XmTextCopy not supported */ 8830 /* XmTextCut not supported */ 8831#ifdef LESSTIF_VERSION 8832 /* This is not supported in LessTif, at least not 0.89. */ 8833 case XCALL_XmTextGetAddMode: 8834 RaiseXWindows(taskData, "XmTextGetAddMode: not implemented"); 8835#else 8836 TextWidgetToBool(XmTextGetAddMode); 8837#endif 8838 TextWidgetToLong(XmTextGetCursorPosition); 8839 TextWidgetToInt(XmTextGetBaseline); 8840 TextWidgetToBool(XmTextGetEditable); 8841 TextWidgetToLong(XmTextGetInsertionPosition); 8842 TextWidgetToLong(XmTextGetLastPosition); 8843 TextWidgetToInt(XmTextGetMaxLength); 8844 TextWidgetToString(XmTextGetSelection); 8845 /* XmTextGetSelectionPosition not supported */ 8846 TextWidgetToString(XmTextGetString); 8847 /* XmTextGetSource not supported */ 8848 TextWidgetToLong(XmTextGetTopCharacter); 8849 8850 case XCALL_XmTextInsert: 8851 { 8852 Widget w = GetTextWidget(taskData, (char *) "XmTextInsert",XP1); 8853 { 8854 unsigned pos = get_C_ulong(taskData, P2); 8855 PolyStringObject *s = GetString(P3); 8856 int size = s->length + 1; 8857 char *buffer = (char *)alloca(size); 8858 8859 Poly_string_to_C(s,buffer,size); 8860 XmTextInsert(w,pos,buffer); 8861 break; 8862 } 8863 } 8864 8865 TextWidgetToBool(XmTextPaste); /* with side effect! */ 8866 /* XmTextPosToXY not supported */ 8867 TextWidgetToBool(XmTextRemove); /* with side effect! */ 8868 8869 case XCALL_XmTextReplace: 8870 { 8871 Widget w = GetTextWidget(taskData, (char *) "XmTextReplace",XP1); 8872 { 8873 unsigned from_pos = get_C_ulong(taskData, P2); 8874 unsigned to_pos = get_C_ulong(taskData, P3); 8875 PolyStringObject *s = GetString(P4); 8876 int size = s->length + 1; 8877 char *buffer = (char *)alloca(size); 8878 8879 Poly_string_to_C(s,buffer,size); 8880 XmTextReplace(w,from_pos,to_pos,buffer); 8881 break; 8882 } 8883 } 8884 8885 TextWidgetIntAction(XmTextScroll); /* for side effect! */ 8886 TextWidgetBoolAction(XmTextSetAddMode); 8887 TextWidgetLongAction(XmTextSetCursorPosition); 8888 TextWidgetBoolAction(XmTextSetEditable); 8889 /* XmTextSetHighlight not supported */ 8890 TextWidgetLongAction(XmTextSetInsertionPosition); 8891 TextWidgetIntAction(XmTextSetMaxLength); 8892 /* XmTextSetSelection not supported */ 8893 /* XmTextSetSource not supported */ 8894 8895 8896 /* inlined SPF 15/2/94 */ 8897 case XCALL_XmTextSetString: 8898 { 8899 Widget w = GetTextWidget(taskData, (char *) "XmTextSetString",XP1); 8900 { 8901 PolyStringObject *s = GetString(P2); 8902 int size = s->length + 1; 8903 char *buffer = (char *)alloca(size); 8904 8905 Poly_string_to_C(s,buffer,size); 8906 XmTextSetString(w,buffer); 8907 break; 8908 } 8909 } 8910 8911 TextWidgetLongAction(XmTextSetTopCharacter); 8912 TextWidgetLongAction(XmTextShowPosition); 8913 8914 case XCALL_XmTextXYToPos: 8915 { 8916 Widget w = GetTextWidget(taskData, (char *) "XmTextXYToPos",XP1); 8917 { 8918 int x = get_C_long(taskData, P2); 8919 int y = get_C_long(taskData, P3); 8920 return Make_int(XmTextXYToPos(w,x,y)); 8921 } 8922 } 8923 8924#undef TextWidgetToLong 8925#undef TextWidgetToInt 8926#undef TextWidgetToBool 8927#undef TextWidgetToString 8928#undef TextWidgetIntAction 8929#undef TextWidgetBoolAction 8930 8931 /******************************************************************************/ 8932 /* */ 8933 /* Operations on XmTextField widgets */ 8934 /* */ 8935 /******************************************************************************/ 8936 8937#define TextFieldWidgetToLong(func) \ 8938 case XCALL_ ## func : \ 8939 return(WidgetToLong(taskData, (char *) #func,GetTextFieldWidget,func,XP1)) 8940 8941 8942#define TextFieldWidgetToInt(func) \ 8943 case XCALL_ ## func : \ 8944 return(WidgetToInt(taskData, (char *) #func,GetTextFieldWidget,func,XP1)) 8945 8946#define TextFieldWidgetToBool(func) \ 8947 case XCALL_ ## func : \ 8948 return(WidgetToBool(taskData, (char *) #func,GetTextFieldWidget,func,XP1)) 8949 8950#define TextFieldWidgetToString(func) \ 8951 case XCALL_ ## func : \ 8952 return(WidgetToString(taskData, (char *) #func,GetTextFieldWidget,func,XP1)) 8953 8954#define TextFieldWidgetIntAction(func) \ 8955 case XCALL_ ## func : \ 8956 WidgetIntAction(taskData, (char *) #func,GetTextFieldWidget,func,XP1,P2); \ 8957 break 8958 8959#define TextFieldWidgetLongAction(func) \ 8960 case XCALL_ ## func : \ 8961 WidgetLongAction(taskData, (char *) #func,GetTextFieldWidget,func,XP1,P2); \ 8962 break 8963 8964#define TextFieldWidgetBoolAction(func) \ 8965 case XCALL_ ## func : \ 8966 WidgetBoolAction(taskData, (char *) #func,GetTextFieldWidget,func,XP1,P2); \ 8967 break 8968 8969 8970 /* XmTextFieldClearSelection not supported */ 8971 /* XmTextFieldCopy not supported */ 8972 /* XmTextFieldCut not supported */ 8973#ifdef LESSTIF_VERSION 8974 /* This is not supported in LessTif, at least not 0.89. */ 8975 case XCALL_XmTextFieldGetAddMode: 8976 RaiseXWindows(taskData, "XmTextFieldGetAddMode: not implemented"); 8977#else 8978 TextFieldWidgetToBool(XmTextFieldGetAddMode); 8979#endif 8980 TextFieldWidgetToInt(XmTextFieldGetBaseline); 8981 TextFieldWidgetToLong(XmTextFieldGetCursorPosition); 8982 TextFieldWidgetToBool(XmTextFieldGetEditable); 8983 TextFieldWidgetToLong(XmTextFieldGetInsertionPosition); 8984 TextFieldWidgetToLong(XmTextFieldGetLastPosition); 8985 TextFieldWidgetToInt(XmTextFieldGetMaxLength); 8986 TextFieldWidgetToString(XmTextFieldGetSelection); 8987 /* XmTextFieldGetSelectionPosition not supported */ 8988 TextFieldWidgetToString(XmTextFieldGetString); 8989 /* XmTextFieldGetSource not supported */ 8990 8991 case XCALL_XmTextFieldInsert: 8992 { 8993 Widget w = GetTextFieldWidget(taskData, (char *) "XmTextFieldInsert",XP1); 8994 { 8995 unsigned pos = get_C_ulong(taskData, P2); 8996 PolyStringObject *s = GetString(P3); 8997 int size = s->length + 1; 8998 char *buffer = (char *)alloca(size); 8999 9000 Poly_string_to_C(s,buffer,size); 9001 XmTextFieldInsert(w,pos,buffer); 9002 break; 9003 } 9004 } 9005 9006 TextFieldWidgetToBool(XmTextFieldPaste); /* for side effect! */ 9007 /* XmTextFieldPosToXY not supported */ 9008 TextFieldWidgetToBool(XmTextFieldRemove); /* for side effect! */ 9009 9010 case XCALL_XmTextFieldReplace: 9011 { 9012 Widget w = GetTextFieldWidget(taskData, (char *) "XmTextFieldReplace",XP1); 9013 { 9014 unsigned from_pos = get_C_ulong(taskData, P2); 9015 unsigned to_pos = get_C_ulong(taskData, P3); 9016 PolyStringObject *s = GetString(P4); 9017 int size = s->length + 1; 9018 char *buffer = (char *)alloca(size); 9019 9020 Poly_string_to_C(s,buffer,size); 9021 XmTextFieldReplace(w,from_pos,to_pos,buffer); 9022 break; 9023 } 9024 } 9025 9026 TextFieldWidgetBoolAction(XmTextFieldSetAddMode); 9027 TextFieldWidgetLongAction(XmTextFieldSetCursorPosition); 9028 TextFieldWidgetBoolAction(XmTextFieldSetEditable); 9029 /* XmTextFieldSetHighlight not supported */ 9030 TextFieldWidgetLongAction(XmTextFieldSetInsertionPosition); 9031 TextFieldWidgetIntAction(XmTextFieldSetMaxLength); 9032 /* XmTextFieldSetSelection not supported */ 9033 9034 9035 /* inlined SPF 15/2/94 */ 9036 case XCALL_XmTextFieldSetString: 9037 { 9038 Widget w = GetTextFieldWidget(taskData, (char *) "XmTextFieldSetString",XP1); 9039 { 9040 PolyStringObject *s = GetString(P2); 9041 int size = s->length + 1; 9042 char *buffer = (char *)alloca(size); 9043 9044 Poly_string_to_C(s,buffer,size); 9045 XmTextFieldSetString(w,buffer); 9046 break; 9047 } 9048 } 9049 9050 TextFieldWidgetLongAction(XmTextFieldShowPosition); /* for side effect! */ 9051 9052 case XCALL_XmTextFieldXYToPos: 9053 { 9054 Widget w = GetTextFieldWidget(taskData, (char *) "XmTextFieldXYToPos",XP1); 9055 { 9056 int x = get_C_long(taskData, P2); 9057 int y = get_C_long(taskData, P3); 9058 return Make_int(XmTextFieldXYToPos(w,x,y)); 9059 } 9060 } 9061 9062 case XCALL_XmTrackingLocate: 9063 return EmptyWidget(taskData, GetDS(taskData, XP1), 9064 XmTrackingLocate(GetWidget(taskData, XP1),GetCursor(taskData, XP2),get_C_ulong(taskData, P3))); 9065 9066 case XCALL_XmUpdateDisplay: 9067 XmUpdateDisplay(GetWidget(taskData, XP1)); 9068 break; 9069 9070#undef TextFieldWidgetToLong 9071#undef TextFieldWidgetToInt 9072#undef TextFieldWidgetToBool 9073#undef TextFieldWidgetToString 9074#undef TextFieldWidgetIntAction 9075#undef TextFieldWidgetLongAction 9076#undef TextFieldWidgetBoolAction 9077 9078 /******************************************************************************/ 9079 /* */ 9080 /* Operations on XmList widgets */ 9081 /* */ 9082 /******************************************************************************/ 9083 9084#define ListWidgetAction(func) \ 9085 case XCALL_ ## func : \ 9086 WidgetAction(taskData, (char *) #func,GetListWidget,func,XP1); \ 9087 break 9088 9089#define ListWidgetBoolAction(func) \ 9090 case XCALL_ ## func : \ 9091 WidgetBoolAction(taskData, (char *) #func,GetListWidget,func,XP1,P2); \ 9092 break 9093 9094#define ListWidgetXmstringAction(func) \ 9095 case XCALL_ ## func : \ 9096 WidgetXmstringAction(taskData, (char *) #func,GetListWidget,func,XP1,P2); \ 9097 break 9098 9099#define ListWidgetXmstringlistAction(func) \ 9100 case XCALL_ ## func : \ 9101 WidgetXmstringlistAction(taskData, (char *) #func,GetListWidget,func,XP1,(ML_Cons_Cell *)XP2); \ 9102 break 9103 9104#define ListWidgetIntAction(func) \ 9105 case XCALL_ ## func : \ 9106 WidgetIntAction(taskData, (char *) #func,GetListWidget,func,XP1,P2); \ 9107 break 9108 9109#define ListWidgetIntIntAction(func) \ 9110 case XCALL_ ## func : \ 9111 WidgetIntIntAction(taskData, (char *) #func,GetListWidget,func,XP1,P2,P3); \ 9112 break 9113 9114#define ListWidgetXmstringIntAction(func) \ 9115 case XCALL_ ## func : \ 9116 WidgetXmstringIntAction(taskData, (char *) #func,GetListWidget,func,XP1,P2,P3); \ 9117 break 9118 9119#define ListWidgetIntBoolAction(func) \ 9120 case XCALL_ ## func : \ 9121 WidgetIntBoolAction(taskData, (char *) #func,GetListWidget,func,XP1,P2,P3); \ 9122 break 9123 9124#define ListWidgetXmstringBoolAction(func) \ 9125 case XCALL_ ## func : \ 9126 WidgetXmstringBoolAction(taskData, (char *) #func,GetListWidget,func,XP1,P2,P3); \ 9127 break 9128 9129#define ListWidgetXmstringlistIntAction(func) \ 9130 case XCALL_ ## func : \ 9131 WidgetXmstringlistIntAction(taskData, (char *) #func,GetListWidget,func,XP1,(ML_Cons_Cell *)XP2,P3); \ 9132 break 9133 9134#define ListWidgetXmstringToIntlist(func) \ 9135 case XCALL_ ## func : \ 9136 return(WidgetXmstringToIntlist(taskData, (char *) #func,GetListWidget,func,XP1,P2)) 9137 9138#define ListWidgetToIntlist(func) \ 9139 case XCALL_ ## func : \ 9140 return(WidgetToIntlist(taskData, (char *) #func,GetListWidget,func,XP1)) 9141 9142#define ListWidgetXmstringToBool(func) \ 9143 case XCALL_ ## func : \ 9144 return(WidgetXmstringToBool(taskData, (char *) #func,GetListWidget,func,XP1,P2)) 9145 9146#define ListWidgetXmstringToInt(func) \ 9147 case XCALL_ ## func : \ 9148 return(WidgetXmstringToInt(taskData, (char *) #func,GetListWidget,func,XP1,P2)) 9149 9150 /************************* Adding Items to List *******************************/ 9151 ListWidgetXmstringIntAction(XmListAddItem); 9152 ListWidgetXmstringIntAction(XmListAddItemUnselected); 9153 ListWidgetXmstringlistIntAction(XmListAddItems); 9154 9155 /************************* Deleting Items from List ***************************/ 9156 ListWidgetAction(XmListDeleteAllItems); 9157 ListWidgetXmstringAction(XmListDeleteItem); 9158 ListWidgetXmstringlistAction(XmListDeleteItems); 9159 ListWidgetIntAction(XmListDeletePos); 9160 ListWidgetIntIntAction(XmListDeleteItemsPos); 9161 9162 /************************* Deselecting Items **********************************/ 9163 ListWidgetAction(XmListDeselectAllItems); 9164 ListWidgetXmstringAction(XmListDeselectItem); 9165 ListWidgetIntAction(XmListDeselectPos); 9166 9167 9168 /************************* Query Functions ************************************/ 9169 ListWidgetXmstringToIntlist(XmListGetMatchPos); 9170 ListWidgetToIntlist(XmListGetSelectedPos); 9171 ListWidgetXmstringToBool(XmListItemExists); 9172 ListWidgetXmstringToInt(XmListItemPos); 9173 9174 /************************* Replacing Items in the List ************************/ 9175 case XCALL_XmListReplaceItems: 9176 /* Unpairing the strings is done in the ML, because it's easier there. */ 9177 { 9178 Widget w = GetListWidget(taskData, (char *) "XmListReplaceItems",XP1); 9179 unsigned n = ListLength(P2); 9180 unsigned n2 = ListLength(P3); 9181 9182 if (n != n2) 9183 { 9184 RaiseXWindows(taskData, "XmListReplaceItems: strings lists are different lengths"); 9185 } 9186 else 9187 { 9188 XmString *oldstrings = (XmString *)alloca(n * sizeof(XmString)); 9189 XmString *newstrings = (XmString *)alloca(n * sizeof(XmString)); 9190 9191 GetList4(taskData, P2,oldstrings,sizeof(XmString),GetXmString); 9192 GetList4(taskData, P3,newstrings,sizeof(XmString),GetXmString); 9193 XmListReplaceItems(w,oldstrings,n,newstrings); 9194 for (unsigned i = 0; i < n; i ++) XmStringFree(oldstrings[i]); 9195 for (unsigned i = 0; i < n; i ++) XmStringFree(newstrings[i]); 9196 } 9197 break; 9198 } 9199 9200 ListWidgetXmstringlistIntAction(XmListReplaceItemsPos); 9201 9202 /************************* Selecting Items in the List ************************/ 9203 ListWidgetXmstringBoolAction(XmListSelectItem); 9204 ListWidgetIntBoolAction(XmListSelectPos); 9205 9206 /************************* Set Add Mode ***************************************/ 9207 ListWidgetBoolAction(XmListSetAddMode); 9208 9209 /************************* Set Appearance *************************************/ 9210 ListWidgetXmstringAction(XmListSetBottomItem); 9211 ListWidgetIntAction(XmListSetBottomPos); 9212 ListWidgetIntAction(XmListSetHorizPos); 9213 ListWidgetXmstringAction(XmListSetItem); 9214 ListWidgetIntAction(XmListSetPos); 9215 9216#undef ListWidgetAction 9217#undef ListWidgetBoolAction 9218#undef ListWidgetXmstringAction 9219#undef ListWidgetXmstringlistAction 9220#undef ListWidgetIntAction 9221#undef ListWidgetIntIntAction 9222#undef ListWidgetXmstringIntAction 9223#undef ListWidgetXmstringBoolAction 9224#undef ListWidgetXmstringlistIntAction 9225#undef ListWidgetXmstringToIntlist 9226#undef ListWidgetToIntlist 9227#undef ListWidgetXmstringToBool 9228#undef ListWidgetXmstringToInt 9229 9230 9231 /* Calls added by DCJM. */ 9232 case XCALL_XmMenuPosition: 9233 MenuPosition( GetWidget(taskData, XP1), get_C_ulong(taskData, P2), get_C_ulong(taskData, P3)); break; 9234 /******************************************************************************/ 9235 /* */ 9236 /* Default case */ 9237 /* */ 9238 /******************************************************************************/ 9239 9240 default: Crash ("Unimplemented X Windows call %d", code); 9241 } 9242 9243 return Make_bool(False); 9244} 9245 9246typedef struct 9247{ 9248 int code; 9249 const char *name; 9250} CodeName; 9251 9252static CodeName ProtocolNames[] = 9253{ 9254 { X_CreateWindow,"XCreateWindow"}, 9255 { X_ChangeWindowAttributes,"XChangeWindowAttributes"}, 9256 { X_GetWindowAttributes,"XGetWindowAttributes"}, 9257 { X_DestroyWindow,"XDestroyWindow"}, 9258 { X_DestroySubwindows,"XDestroySubwindows"}, 9259 { X_ChangeSaveSet,"XChangeSAVESet"}, 9260 { X_ReparentWindow,"XReparentWindow"}, 9261 { X_MapWindow,"XMapWindow"}, 9262 { X_MapSubwindows,"XMapSubwindows"}, 9263 { X_UnmapWindow,"XUnmapWindow"}, 9264 { X_UnmapSubwindows,"XUnmapSubwindows"}, 9265 { X_ConfigureWindow,"XConfigureWindow"}, 9266 { X_CirculateWindow,"XCirculateWindow"}, 9267 { X_GetGeometry,"XGetGeometry"}, 9268 { X_QueryTree,"XQueryTree"}, 9269 { X_InternAtom,"XInternAtom"}, 9270 { X_GetAtomName,"XGetAtomName"}, 9271 { X_ChangeProperty,"XChangeProperty"}, 9272 { X_DeleteProperty,"XDeleteProperty"}, 9273 { X_GetProperty,"XGetProperty"}, 9274 { X_ListProperties,"XListProperties"}, 9275 { X_SetSelectionOwner,"XSetSelectionOwner"}, 9276 { X_GetSelectionOwner,"XGetSelectionOwner"}, 9277 { X_ConvertSelection,"XConvertSelection"}, 9278 { X_SendEvent,"XSendEvent"}, 9279 { X_GrabPointer,"XGrabPointer"}, 9280 { X_UngrabPointer,"XUngrabPointer"}, 9281 { X_GrabButton,"XGrabButton"}, 9282 { X_UngrabButton,"XUngrabButton"}, 9283 { X_ChangeActivePointerGrab,"XChangeActivePointerGrab"}, 9284 { X_GrabKeyboard,"XGrabKeyboard"}, 9285 { X_UngrabKeyboard,"XUngrabKeyboard"}, 9286 { X_GrabKey,"XGrabKey"}, 9287 { X_UngrabKey,"XUngrabKey"}, 9288 { X_AllowEvents,"XAllowEvents"}, 9289 { X_GrabServer,"XGrabServer"}, 9290 { X_UngrabServer,"XUngrabServer"}, 9291 { X_QueryPointer,"XQueryPointer"}, 9292 { X_GetMotionEvents,"XGetMotionEvents"}, 9293 { X_TranslateCoords,"XTranslateCoords"}, 9294 { X_WarpPointer,"XWarpPointer"}, 9295 { X_SetInputFocus,"XSetInputFocus"}, 9296 { X_GetInputFocus,"XGetInputFocus"}, 9297 { X_QueryKeymap,"XQueryKeymap"}, 9298 { X_OpenFont,"XOpenFont"}, 9299 { X_CloseFont,"XCloseFont"}, 9300 { X_QueryFont,"XQueryFont"}, 9301 { X_QueryTextExtents,"XQueryTextExtents"}, 9302 { X_ListFonts,"XListFonts"}, 9303 { X_ListFontsWithInfo,"XListFontsWithInfo"}, 9304 { X_SetFontPath,"XSetFontPath"}, 9305 { X_GetFontPath,"XGetFontPath"}, 9306 { X_CreatePixmap,"XCreatePixmap"}, 9307 { X_FreePixmap,"XFreePixmap"}, 9308 { X_CreateGC,"XCreateGC"}, 9309 { X_ChangeGC,"XChangeGC"}, 9310 { X_CopyGC,"XCopyGC"}, 9311 { X_SetDashes,"XSetDashes"}, 9312 { X_SetClipRectangles,"XSetClipRectangles"}, 9313 { X_FreeGC,"XFreeGC"}, 9314 { X_ClearArea,"XClearArea"}, 9315 { X_CopyArea,"XCopyArea"}, 9316 { X_CopyPlane,"XCopyPlane"}, 9317 { X_PolyPoint,"XPolyPoint"}, 9318 { X_PolyLine,"XPolyLine"}, 9319 { X_PolySegment,"XPolySegment"}, 9320 { X_PolyRectangle,"XPolyRectangle"}, 9321 { X_PolyArc,"XPolyArc"}, 9322 { X_FillPoly,"XFillPoly"}, 9323 { X_PolyFillRectangle,"XPolyFillRectangle"}, 9324 { X_PolyFillArc,"XPolyFillArc"}, 9325 { X_PutImage,"XPutImage"}, 9326 { X_GetImage,"XGetImage"}, 9327 { X_PolyText8,"XPolyText8"}, 9328 { X_PolyText16,"XPolyText16"}, 9329 { X_ImageText8,"XImageText8"}, 9330 { X_ImageText16,"XImageText16"}, 9331 { X_CreateColormap,"XCreateColormap"}, 9332 { X_FreeColormap,"XFreeColormap"}, 9333 { X_CopyColormapAndFree,"XCopyColormapAndFree"}, 9334 { X_InstallColormap,"XInstallColormap"}, 9335 { X_UninstallColormap,"XUninstallColormap"}, 9336 { X_ListInstalledColormaps,"XListInstalledColormaps"}, 9337 { X_AllocColor,"XAllocColor"}, 9338 { X_AllocNamedColor,"XAllocNamedColor"}, 9339 { X_AllocColorCells,"XAllocColorCells"}, 9340 { X_AllocColorPlanes,"XAllocColorPlanes"}, 9341 { X_FreeColors,"XFreeColors"}, 9342 { X_StoreColors,"XStoreColors"}, 9343 { X_StoreNamedColor,"XStoreNamedColor"}, 9344 { X_QueryColors,"XQueryColors"}, 9345 { X_LookupColor,"XLookupColor"}, 9346 { X_CreateCursor,"XCreateCursor"}, 9347 { X_CreateGlyphCursor,"XCreateGlyphCursor"}, 9348 { X_FreeCursor,"XFreeCursor"}, 9349 { X_RecolorCursor,"XRecolorCursor"}, 9350 { X_QueryBestSize,"XQueryBestSize"}, 9351 { X_QueryExtension,"XQueryExtension"}, 9352 { X_ListExtensions,"XListExtensions"}, 9353 { X_ChangeKeyboardMapping,"XChangeKeyboardMapping"}, 9354 { X_GetKeyboardMapping,"XGetKeyboardMapping"}, 9355 { X_ChangeKeyboardControl,"XChangeKeyboardControl"}, 9356 { X_GetKeyboardControl,"XGetKeyboardControl"}, 9357 { X_Bell,"XBell"}, 9358 { X_ChangePointerControl,"XChangePointerControl"}, 9359 { X_GetPointerControl,"XGetPointerControl"}, 9360 { X_SetScreenSaver,"XSetScreenSaver"}, 9361 { X_GetScreenSaver,"XGetScreenSaver"}, 9362 { X_ChangeHosts,"XChangeHosts"}, 9363 { X_ListHosts,"XListHosts"}, 9364 { X_SetAccessControl,"XSetAccessControl"}, 9365 { X_SetCloseDownMode,"XSetCloseDownMode"}, 9366 { X_KillClient,"XKillClient"}, 9367 { X_RotateProperties,"XRotateProperties"}, 9368 { X_ForceScreenSaver,"XForceScreenSaver"}, 9369 { X_SetPointerMapping,"XSetPointerMapping"}, 9370 { X_GetPointerMapping,"XGetPointerMapping"}, 9371 { X_SetModifierMapping,"XSetModifierMapping"}, 9372 { X_GetModifierMapping,"XGetModifierMapping"}, 9373 { X_NoOperation,"XNoOperation"} 9374}; 9375 9376static CodeName ProtocolErrors[] = 9377{ 9378 { Success,"Success"}, 9379 { BadRequest,"BadRequest"}, 9380 { BadValue,"BadValue"}, 9381 { BadWindow,"BadWindow"}, 9382 { BadPixmap,"BadPixmap"}, 9383 { BadAtom,"BadAtom"}, 9384 { BadCursor,"BadCursor"}, 9385 { BadFont,"BadFont"}, 9386 { BadMatch,"BadMatch"}, 9387 { BadDrawable,"BadDrawable"}, 9388 { BadAccess,"BadAccess"}, 9389 { BadAlloc,"BadAlloc"}, 9390 { BadColor,"BadColor"}, 9391 { BadGC,"BadGC"}, 9392 { BadIDChoice,"BadIDChoice"}, 9393 { BadName,"BadName"}, 9394 { BadLength,"BadLength"}, 9395 { BadImplementation,"BadImplementation"} 9396}; 9397 9398static int XWindowsError(Display *display, XErrorEvent *error) 9399{ 9400 const char *errorName = "unknown"; 9401 const char *requestName = "unknown"; 9402 int i,n; 9403 char buffer[500]; 9404 9405 n = sizeof(ProtocolErrors) / sizeof(ProtocolErrors[0]); 9406 9407 for(i = 0; i < n; i++) 9408 { 9409 if (ProtocolErrors[i].code == error->error_code) 9410 { 9411 errorName = ProtocolErrors[i].name; 9412 } 9413 } 9414 9415 n = sizeof(ProtocolNames) / sizeof(ProtocolNames[0]); 9416 9417 for(i = 0; i < n; i++) 9418 { 9419 if (ProtocolNames[i].code == error->request_code) 9420 { 9421 requestName = ProtocolNames[i].name; 9422 } 9423 } 9424 9425 sprintf(buffer,"%s in %s",errorName,requestName); 9426 9427 printf("\nX Error %s\n\n", buffer); 9428 9429#if NEVER 9430 /* Raise exception if we are running in synchronous mode */ 9431 if (display->private15) RaiseXWindows(taskData, buffer); 9432#endif 9433 9434 return 0; /* DUMMY value - SPF 6/1/94 */ 9435} 9436 9437struct _entrypts xwindowsEPT[] = 9438{ 9439 { "PolyXWindowsGeneral", (polyRTSFunction)&PolyXWindowsGeneral}, 9440 9441 { NULL, NULL} // End of list. 9442}; 9443 9444class XWinModule: public RtsModule 9445{ 9446public: 9447 virtual void Init(void); 9448 void GarbageCollect(ScanAddress *process); 9449}; 9450 9451// Declare this. It will be automatically added to the table. 9452static XWinModule xwinModule; 9453 9454 9455void XWinModule::GarbageCollect(ScanAddress *process) 9456{ 9457 /* Process all the objects in the list. If an object */ 9458 /* is not found from outside then it is removed. */ 9459 9460 T_List **T = &TList; 9461 C_List **C = &CList; 9462 9463 int i; 9464 9465 /* process all XList headers */ 9466 for (i = 0; i < XLISTSIZE; i++) 9467 { 9468 X_List *L = XList[i]; 9469 9470 while(L) 9471 { 9472 PolyObject *P = L->object; /* copy object pointer */ 9473 X_List *N = L->next; /* copy next pointer */ 9474 process->ScanRuntimeAddress(&P, ScanAddress::STRENGTH_WEAK); 9475 9476 /* P may have been moved, or overwritten with a 0 if not accessible */ 9477 9478 if (P == 0) 9479 DestroyXObject(L->object); 9480 else 9481 L->object = (X_Object*)P; 9482 9483 L = N; 9484 } 9485 } 9486 9487 /* Process the timeout/message list */ 9488 9489 while (*T) 9490 { 9491 T_List *t = *T; 9492 9493 process->ScanRuntimeAddress(&t->alpha, ScanAddress::STRENGTH_STRONG); 9494 process->ScanRuntimeAddress(&t->handler, ScanAddress::STRENGTH_STRONG); 9495 9496 PolyObject *obj = t->window_object; 9497 process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_WEAK); 9498 t->window_object = (X_Window_Object*)obj; 9499 9500 obj = t->widget_object; 9501 process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_STRONG); 9502 t->widget_object = (X_Widget_Object*)obj; 9503 9504 // DCJM: I don't understand this. The widget entry will never go 9505 // to zero since it's strong not weak. 9506 if (t->window_object == 0 && t->widget_object == 0) 9507 { 9508 *T = t->next; 9509 9510 free(t); 9511 } 9512 else T = &t->next; 9513 } 9514 9515 /* Process the callback list */ 9516 9517 while(*C) 9518 { 9519 C_List *c = *C; 9520 process->ScanRuntimeAddress(&c->function, ScanAddress::STRENGTH_STRONG); 9521 9522 PolyObject *obj = c->widget_object; 9523 process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_STRONG); 9524 c->widget_object = (X_Widget_Object*)obj; 9525 9526 /* DCJM: This doesn't make sense. The widget entry will only 9527 go to zero if the G.C. operation was weak, not strong as in 9528 the line above. */ 9529 if (c->widget_object == 0) 9530 { 9531 *C = c->next; 9532 9533 free(c); 9534 } 9535 else C = &c->next; 9536 } 9537 9538 /* Process the callback waiting list */ 9539 if (! FList.IsTagged()) 9540 { 9541 PolyObject *obj = FList.AsObjPtr(); 9542 process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_STRONG); 9543 FList = obj; 9544 } 9545 9546 /* and the Xt event waiting list. */ 9547 if (! GList.IsTagged()) 9548 { 9549 PolyObject *obj = GList.AsObjPtr(); 9550 process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_STRONG) ; 9551 GList = obj; 9552 } 9553} 9554 9555 9556void XWinModule::Init(void) 9557{ 9558 initXList(); /* added 9/12/93 SPF */ 9559 9560 XtToolkitThreadInitialize(); 9561 XtToolkitInitialize(); 9562 9563 XSetErrorHandler(XWindowsError); 9564} 9565 9566POLYUNSIGNED PolyXWindowsGeneral(PolyObject *threadId, PolyWord params) 9567{ 9568 TaskData *taskData = TaskData::FindTaskForId(threadId); 9569 taskData->PreRTSCall(); 9570 Handle reset = taskData->saveVec.mark(); 9571 Handle pushedArg = taskData->saveVec.push(params); 9572 Handle result = 0; 9573 9574 try { 9575 result = XWindows_c(taskData, pushedArg); 9576 } 9577 catch (KillException &) { 9578 processes->ThreadExit(taskData); // May test for kill 9579 } 9580 catch (...) { } // If an ML exception is raised 9581 9582 taskData->saveVec.reset(reset); 9583 taskData->PostRTSCall(); 9584 if (result == 0) return TAGGED(0).AsUnsigned(); 9585 else return result->Word().AsUnsigned(); 9586} 9587 9588#else 9589// We haven't got X or we haven't got Motif 9590 9591#include "globals.h" 9592#include "run_time.h" 9593#include "sys.h" 9594#include "save_vec.h" 9595#include "machine_dep.h" 9596#include "processes.h" 9597#include "rtsentry.h" 9598 9599#include "xwindows.h" 9600 9601extern "C" { 9602 POLYEXTERNALSYMBOL POLYUNSIGNED PolyXWindowsGeneral(PolyObject *threadId, PolyWord params); 9603} 9604 9605Handle XWindows_c(TaskData *taskData, Handle/*params*/) 9606{ 9607 raise_exception_string(taskData, EXC_XWindows, "Not implemented"); 9608 9609 /*NOTREACHED*/ 9610 return taskData->saveVec.push(TAGGED(0)); /* just to keep lint happy */ 9611} 9612 9613POLYUNSIGNED PolyXWindowsGeneral(PolyObject *threadId, PolyWord /*params*/) 9614{ 9615 TaskData *taskData = TaskData::FindTaskForId(threadId); 9616 taskData->PreRTSCall(); 9617 9618 try { 9619 raise_exception_string(taskData, EXC_XWindows, "Not implemented"); 9620 } catch (...) { } // Handle the C++ exception 9621 9622 taskData->PostRTSCall(); 9623 return TAGGED(0).AsUnsigned(); // Return unit since we're raising an exception 9624} 9625 9626struct _entrypts xwindowsEPT[] = 9627{ 9628 { "PolyXWindowsGeneral", (polyRTSFunction)&PolyXWindowsGeneral}, 9629 9630 { NULL, NULL} // End of list. 9631}; 9632 9633#endif 9634 9635