1 /*
2 Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
3 This program is free software; you can redistribute it and/or
4 modify it under the same terms as Perl itself.
5 */
6 #define PERL_NO_GET_CONTEXT
7 #include <EXTERN.h>
8 #include <perl.h>
9 #include <XSUB.h>
10 #include <patchlevel.h>
11
12 #include "tkGlue.def"
13
14 static STRLEN na; /* Quick and dirty fix */
15
16 #include "pTk/tkPort.h"
17 #include "pTk/tkInt.h"
18 #include "pTk/tkFont.h"
19 #include "pTk/tkXrm.h"
20 #include "pTk/default.h"
21
22 #if defined(__WIN32__) && !defined(__EMX__)
23 # include "pTk/tkWinInt.h"
24 #endif
25
26 #include "tkGlue.h"
27
28 #ifdef NEED_PRELOAD
29 #ifdef I_DLFCN
30 #include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
31 #else
32 #include <nlist.h>
33 #include <link.h>
34 #endif
35 #define NeedPreload() 1
36 #else
37
38 #define NeedPreload() 0
39 #endif
40
41 #define Tk_tainting() (PL_tainting)
42 #define Tk_tainted(sv) ((sv) ? SvTAINTED(sv) : PL_tainted)
43
44 static void
DebugHook(SV * sv)45 DebugHook(SV *sv)
46 {
47
48 }
49
50 #define XEvent_DESTROY(obj)
51
52 #define Tk_XRaiseWindow(w) XRaiseWindow(Tk_Display(w),Tk_WindowId(w))
53
54 #define Const_DONT_WAIT() (TCL_DONT_WAIT)
55 #define Const_WINDOW_EVENTS() (TCL_WINDOW_EVENTS)
56 #define Const_FILE_EVENTS() (TCL_FILE_EVENTS)
57 #define Const_TIMER_EVENTS() (TCL_TIMER_EVENTS)
58 #define Const_IDLE_EVENTS() (TCL_IDLE_EVENTS)
59 #define Const_ALL_EVENTS() (TCL_ALL_EVENTS)
60
61 #ifndef SELECT_FG
62 /* Should really depend on color/mono */
63 #define SELECT_FG BLACK
64 #endif
65
66 #define Const_NORMAL_BG() (NORMAL_BG)
67 #define Const_ACTIVE_BG() (ACTIVE_BG)
68 #define Const_SELECT_BG() (SELECT_BG)
69 #define Const_SELECT_FG() (SELECT_FG)
70 #define Const_TROUGH() (TROUGH)
71 #define Const_INDICATOR() (INDICATOR)
72 #define Const_DISABLED() (DISABLED)
73 #define Const_BLACK() (BLACK)
74 #define Const_WHITE() (WHITE)
75
76 static XFontStruct * TkwinFont _((Tk_Window tkwin, Tk_Uid name));
77
78 #define pTk_Synchronize(win,flag) \
79 XSynchronize(Tk_Display(win), flag)
80
81 static IV
PointToWindow(Tk_Window tkwin,int x,int y,Window dest)82 PointToWindow(Tk_Window tkwin, int x, int y, Window dest)
83 {
84 Display *dpy = Tk_Display(tkwin);
85 Window root = RootWindowOfScreen(Tk_Screen(tkwin));
86 Window win = None;
87 if (dest == None)
88 dest = root;
89 #ifdef WIN32
90 {
91 HWND hwnd = (HWND) Tk_GetHWND(dest);
92 RECT r;
93 if (GetWindowRect(hwnd,&r))
94 {
95 POINT pt;
96 HWND child;
97 pt.x = x - r.left;
98 pt.y = y - r.top;
99 child = ChildWindowFromPoint(hwnd, pt);
100 if (child != hwnd)
101 {
102 TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(child);
103 if (winPtr)
104 {
105 win = winPtr->window;
106 }
107 }
108 }
109 return (IV) win;
110 }
111 #else
112 if (!XTranslateCoordinates(dpy, root, dest, x, y, &x, &y, &win))
113 {
114 win = None;
115 }
116 return (IV) win;
117 #endif
118 }
119
120 static SV *
StringAlias(pTHX_ const char * s)121 StringAlias(pTHX_ const char *s)
122 {
123 SV *sv = newSV(0);
124 sv_upgrade(sv,SVt_PV);
125 SvPVX(sv) = (char *) s;
126 SvCUR_set(sv,strlen(s));
127 SvLEN(sv) = 0;
128 SvPOK_only(sv);
129 SvREADONLY_on(sv);
130 return sv;
131 }
132
133 typedef struct
134 {
135 CONST char *foundary;
136 CONST char *encoding;
137 TkFontAttributes attrib;
138 const char *name;
139 } LangFontInfo;
140
141 static SV *
FontInfo(pTHX_ const char * encoding,const char * foundary,const TkFontAttributes * attrib,const char * name)142 FontInfo(pTHX_ const char *encoding, const char *foundary,
143 const TkFontAttributes *attrib, const char *name)
144 {
145 SV *sv = newSV(sizeof(LangFontInfo));
146 LangFontInfo *info = (LangFontInfo *) SvPVX(sv);
147 SvCUR_set(sv,sizeof(LangFontInfo));
148 SvPOK_only(sv);
149 info->encoding = encoding;
150 info->foundary = foundary;
151 info->attrib = *attrib;
152 /* FIXME */
153 info->name = name;
154 return sv_bless(newRV_noinc(sv),gv_stashpv("Tk::FontRankInfo", TRUE));
155 }
156
157 #define Boolean int
158
159 #define FontInfo_encoding(p) (StringAlias(aTHX_ (p)->encoding))
160 #define FontInfo_foundary(p) (StringAlias(aTHX_ (p)->foundary))
161 #define FontInfo_Xname(p) (StringAlias(aTHX_ (p)->name))
162 #define FontInfo_family(p) (StringAlias(aTHX_ (p)->attrib.family))
163 #define FontInfo_size(p) ((p)->attrib.size)
164 #define FontInfo_bold(p) ((p)->attrib.weight == TK_FW_BOLD)
165 #define FontInfo_italic(p) ((p)->attrib.slant == TK_FS_ITALIC)
166
167 unsigned int
LangFontRank(unsigned int suggested,int ch,CONST char * gotName,CONST char * wantFoundary,CONST TkFontAttributes * wantAttrib,CONST char * wantEncoding,CONST char * gotFoundary,CONST TkFontAttributes * gotAttrib,CONST char * gotEncoding)168 LangFontRank(unsigned int suggested,
169 int ch,
170 CONST char *gotName,
171 CONST char *wantFoundary,
172 CONST TkFontAttributes *wantAttrib,
173 CONST char *wantEncoding,
174 CONST char *gotFoundary,
175 CONST TkFontAttributes *gotAttrib,
176 CONST char *gotEncoding)
177 {
178 dTHX;
179 SV *hook = get_sv("Tk::FontRank",0);
180 if (hook && SvOK(hook))
181 {
182 dSP;
183 int flags = (suggested == 0 || suggested == (unsigned int) -1)
184 ? G_VOID : G_SCALAR;
185 SV *result, *sv;
186 int count;
187 ENTER;
188 SAVETMPS;
189 LangPushCallbackArgs(&hook);
190 result = Nullsv;
191 sv = newSV(UTF8_MAXLEN);
192 sv_upgrade(sv,SVt_PVIV);
193 #ifdef UNICODE_ALLOW_ANY
194 count = uvchr_to_utf8_flags((U8 *) SvPVX(sv),ch, UNICODE_ALLOW_ANY)
195 - (U8 *) SvPVX(sv);
196 #else
197 count = Perl_uv_to_utf8(aTHX_ (U8 *) SvPVX(sv),ch) - (U8 *) SvPVX(sv);
198 #endif
199 SvCUR_set(sv,count);
200 SvPOK_on(sv);
201 SvUTF8_on(sv);
202 SvIVX(sv) = ch;
203 SvIOK_on(sv);
204 SPAGAIN;
205 XPUSHs(sv_2mortal(newSViv((IV) suggested)));
206 XPUSHs(sv_2mortal(sv));
207 XPUSHs(sv_2mortal(FontInfo(aTHX_ wantEncoding, wantFoundary, wantAttrib, Nullch)));
208 XPUSHs(sv_2mortal(FontInfo(aTHX_ gotEncoding, gotFoundary, gotAttrib,gotName)));
209 PUTBACK;
210 if ((count = LangCallCallback(hook, G_EVAL | flags)))
211 {
212 SPAGAIN;
213 result = POPs;
214 PUTBACK;
215 }
216 if (SvTRUE(ERRSV))
217 {
218 warn("%"SVf,ERRSV);
219 sv_setsv(hook,&PL_sv_undef);
220 }
221 else
222 {
223 if (result && SvOK(result))
224 {
225 if (SvPOK(result) && !SvCUR(result))
226 {
227 suggested = (unsigned int) -2;
228 }
229 else
230 suggested = (unsigned int) SvIV(result);
231 }
232 else
233 {
234 suggested = (unsigned int) -1;
235 }
236 }
237 FREETMPS;
238 LEAVE;
239 }
240 /* Placeholder for a hook */
241 if (0 && !suggested)
242 LangDebug("%08x for U+%04x %s from %s\n",suggested,ch, gotEncoding, gotName);
243 return suggested;
244 }
245
246
247 MODULE = Tk PACKAGE = Tk::FontRankInfo PREFIX = FontInfo_
248 PROTOTYPES: ENABLE
249
250 SV *
FontInfo_encoding(LangFontInfo * p)251 FontInfo_encoding(LangFontInfo *p)
252
253 SV *
254 FontInfo_foundary(LangFontInfo *p)
255
256 SV *
257 FontInfo_Xname(LangFontInfo *p)
258
259 SV *
260 FontInfo_family(LangFontInfo *p)
261
262 int
263 FontInfo_size(LangFontInfo *p)
264
265 Boolean
266 FontInfo_bold(LangFontInfo *p)
267
268 Boolean
269 FontInfo_italic(LangFontInfo *p)
270
271
272 MODULE = Tk PACKAGE = Tk PREFIX = Const_
273 PROTOTYPES: ENABLE
274
275 char *
276 Const_BLACK()
277
278 char *
279 Const_WHITE()
280
281 char *
282 Const_NORMAL_BG()
283
284 char *
285 Const_ACTIVE_BG()
286
287 char *
288 Const_SELECT_BG()
289
290 char *
291 Const_SELECT_FG()
292
293 char *
294 Const_TROUGH()
295
296 char *
297 Const_INDICATOR()
298
299 char *
300 Const_DISABLED()
301
302
303 IV
304 Const_DONT_WAIT()
305
306 IV
307 Const_WINDOW_EVENTS()
308
309 IV
310 Const_FILE_EVENTS()
311
312 IV
313 Const_TIMER_EVENTS()
314
315 IV
316 Const_IDLE_EVENTS()
317
318 IV
319 Const_ALL_EVENTS()
320
321 MODULE = Tk PACKAGE = Tk::Xrm PREFIX = Xrm_
322 PROTOTYPES: DISABLE
323
324 void
325 Xrm_import(class,...)
326 char * class
327
328 MODULE = Tk PACKAGE = XEvent PREFIX = XEvent_
329
330 void
331 XEvent_Info(obj,s)
332 EventAndKeySym * obj
333 char * s
334 CODE:
335 {
336 ST(0) = XEvent_Info(obj,s);
337 }
338
339 void
XEvent_DESTROY(obj)340 XEvent_DESTROY(obj)
341 SV * obj
342
343 MODULE = Tk PACKAGE = Tk::MainWindow PREFIX = pTk_
344
345 PROTOTYPES: DISABLE
346
347 void
348 pTk_Synchronize(win,flag = True)
349 Tk_Window win
350 int flag
351
352 int
353 Count(self)
354 SV * self
355 CODE:
356 {
357 ST(0) = sv_2mortal(newSViv(Tk_GetNumMainWindows()));
358 }
359
360
361 MODULE = Tk PACKAGE = Tk::Callback PREFIX = Callback_
362
363 void
new(package,what)364 new(package,what)
365 char * package
366 SV * what
367 CODE:
368 {
369 ST(0) = sv_2mortal(sv_bless(LangMakeCallback(what),gv_stashpv(package, TRUE)));
370 }
371
372 void
Substitute(cb,src,dst)373 Substitute(cb,src,dst)
374 SV * cb
375 SV * src
376 SV * dst
377 CODE:
378 {
379 if (!SvROK(cb))
380 croak("callback is not a reference");
381 cb = SvRV(cb);
382 if (!SvROK(src))
383 croak("src is not a reference");
384 src = SvRV(src);
385 if (!SvROK(dst))
386 croak("dst is not a reference");
387
388 if (SvTYPE(cb) == SVt_PVAV)
389 {
390 AV *av = newAV();
391 int n = av_len((AV *) cb);
392 int i;
393 int match = 0;
394 for (i=0; i <= n; i++)
395 {
396 SV **svp = av_fetch((AV *) cb,i,0);
397 if (svp)
398 {
399 if (SvROK(*svp) && SvRV(*svp) == src)
400 {
401 av_store(av, i, SvREFCNT_inc(dst));
402 match++;
403 }
404 else
405 {
406 av_store(av, i, SvREFCNT_inc(*svp));
407 }
408 }
409 }
410 if (match)
411 {
412 ST(0) = sv_2mortal(sv_bless(MakeReference((SV *) av),SvSTASH(cb)));
413 }
414 else
415 {
416 SvREFCNT_dec(av);
417 }
418 }
419 }
420
421 MODULE = Tk PACKAGE = Tk PREFIX = Tk
422
423 int
424 NeedPreload()
425
426 void
427 Preload(filename)
428 char * filename
429 CODE:
430 #ifdef NEED_PRELOAD
431 void *h = dlopen(filename, RTLD_LAZY|RTLD_GLOBAL) ;
432 if (!h)
433 croak("Cannot load %s",filename);
434 #endif
435
436 double
timeofday()437 timeofday()
438 CODE:
439 {
440 Tcl_Time t;
441 Tcl_GetTime(&t);
442 RETVAL = t.sec + (double) t.usec/1e6;
443 }
444 OUTPUT:
445 RETVAL
446
447 TkWindow *
TkGetFocusWin(win)448 TkGetFocusWin(win)
449 TkWindow * win
450
451 void
452 TkGetPointerCoords(win)
453 Tk_Window win
454 PPCODE:
455 {
456 int x, y;
457 TkGetPointerCoords(win, &x, &y);
458 PUSHs(sv_2mortal(newSViv(x)));
459 PUSHs(sv_2mortal(newSViv(y)));
460 }
461
462 MODULE = Tk PACKAGE = Tk PREFIX = Tk_
463
464 void
Tk_CheckHash(widget)465 Tk_CheckHash(widget)
466 SV * widget
467 CODE:
468 {
469 Tk_CheckHash(widget,NULL);
470 }
471
472 void
Debug(widget,string)473 Debug(widget,string)
474 SV * widget;
475 char * string
476 CODE:
477 {
478 LangDumpVec(string,1,&SvRV(widget));
479 }
480
481 void
WidgetMethod(widget,name,...)482 WidgetMethod(widget,name,...)
483 SV * widget;
484 SV * name;
485 CODE:
486 {
487 Lang_CmdInfo *info = WindowCommand(widget, NULL, 1);
488 TKXSRETURN(Call_Tk(info, items, &ST(0)));
489 }
490
491 void
OldEnterMethods(package,file,...)492 OldEnterMethods(package,file,...)
493 char * package
494 char * file
495 CODE:
496 {int i;
497 char buf[80]; /* FIXME Size of buffer */
498 for (i=2; i < items; i++)
499 {
500 STRLEN len;
501 SV *method = newSVsv(ST(i));
502 CV *cv;
503 sprintf(buf, "%s::%s", package, SvPV(method,len));
504 cv = newXS(buf, XStoWidget, file);
505 CvXSUBANY(cv).any_ptr = method;
506 }
507 }
508
509 IV
GetFILE(arg,w)510 GetFILE(arg,w)
511 SV * arg
512 int w
513 CODE:
514 {
515 IO *io = sv_2io(arg);
516 RETVAL = -1;
517 if (io)
518 {
519 PerlIO *f = (w) ? IoOFP(io) : IoIFP(io);
520 if (f)
521 {
522 RETVAL = PerlIO_fileno(f);
523 }
524 }
525 }
526 OUTPUT:
527 RETVAL
528
529 MODULE = Tk PACKAGE = Tk::Widget PREFIX = pTk_
530
531 IV
532 PointToWindow(tkwin,x,y,parent = None)
533 Tk_Window tkwin
534 int x
535 int y
536 IV parent
537
538 void
539 WindowXY(tkwin,src = None, dst = None)
540 Tk_Window tkwin
541 IV src
542 IV dst
543 PPCODE:
544 {
545 Display *dpy = Tk_Display(tkwin);
546 Window root = RootWindowOfScreen(Tk_Screen(tkwin));
547 int x = 0;
548 int y = 0;
549 if (src == None)
550 src = Tk_WindowId(tkwin);
551 if (dst == None)
552 dst = root;
553 XTranslateCoordinates(dpy, src, dst, 0, 0, &x, &y, &root);
554 XPUSHs(sv_2mortal(newSViv(x)));
555 XPUSHs(sv_2mortal(newSViv(y)));
556 }
557
558 void
pTk_DefineBitmap(tkwin,name,width,height,source)559 pTk_DefineBitmap (tkwin, name, width, height, source)
560 Tk_Window tkwin;
561 char * name;
562 int width;
563 int height;
564 SV * source;
565 CODE:
566 {
567 Tcl_Interp *interp;
568 if (TkToWidget(tkwin,&interp) && interp)
569 {STRLEN len;
570 SV * source_copy = newSVsv(source); /* technically this is leaking a SV, but there's no DeleteBitmap or so anyway */
571 unsigned char *data = (unsigned char *) SvPV(source_copy, len);
572 STRLEN byte_line = (width + 7) / 8;
573 if (len == height * byte_line)
574 {
575 Tcl_ResetResult(interp);
576 if (Tk_DefineBitmap(interp, Tk_GetUid(name), data, width, height) != TCL_OK)
577 croak("%s",Tcl_GetStringResult(interp));
578 }
579 else
580 {
581 croak("Data wrong size for %dx%d bitmap",width,height);
582 }
583 }
584 else
585 {
586 croak("Invalid widget");
587 }
588 }
589
590 void
pTk_GetBitmap(tkwin,name)591 pTk_GetBitmap(tkwin, name)
592 Tk_Window tkwin;
593 char * name;
594 PPCODE:
595 {
596 Tcl_Interp *interp;
597 Pixmap pixmap;
598 if (TkToWidget(tkwin,&interp) && interp)
599 {
600 pixmap = Tk_GetBitmap(interp, tkwin, name);
601 if (pixmap == None)
602 PUSHs(&PL_sv_undef);
603 else
604 PUSHs(sv_2mortal(newSViv((IV)pixmap)));
605 }
606 else
607 {
608 croak("Invalid widget");
609 }
610 }
611
612
613 MODULE = Tk PACKAGE = Tk::Widget PREFIX = Tk_
614
615 void
UnmanageGeometry(win)616 UnmanageGeometry(win)
617 Tk_Window win
618 CODE:
619 {
620 Tk_ManageGeometry(win, NULL, NULL);
621 }
622
623 void
DisableButtonEvents(win)624 DisableButtonEvents(win)
625 Tk_Window win
626 CODE:
627 {
628 Tk_Attributes(win)->event_mask
629 &= ~(ButtonPressMask | ButtonReleaseMask | ButtonMotionMask);
630 Tk_ChangeWindowAttributes(win, CWEventMask, Tk_Attributes(win));
631 }
632
633 void
MakeAtom(win,...)634 MakeAtom(win,...)
635 Tk_Window win
636 CODE:
637 {
638 int i;
639 for (i=1; i < items; i++)
640 {
641 SV *sv = ST(i);
642 Atom a = None;
643 const char *name = Nullch;
644 if (SvGMAGICAL(sv))
645 mg_get(sv);
646 if (SvIOK(sv) && !SvPOK(sv))
647 {
648 a = (Atom) SvIVX(sv);
649 if (a != None)
650 {
651 sv_upgrade(sv,SVt_PVIV);
652 name = Tk_GetAtomName(win,a);
653 sv_setpvn(sv,name,strlen(name));
654 SvIVX(sv) = (IV) a;
655 SvIOK_on(sv);
656 }
657 }
658 else if (SvPOK(sv) && !SvIOK(sv))
659 {
660 name = SvPVX(sv);
661 if (name && *name)
662 {
663 sv_upgrade(sv,SVt_PVIV);
664 a = Tk_InternAtom(win,name);
665 SvIVX(sv) = (IV) a;
666 SvIOK_on(sv);
667 }
668 }
669 else if (SvPOK(sv) && SvIOK(sv))
670 {
671 name = SvPVX(sv);
672 a = (Atom) SvIVX(sv);
673 if (a != Tk_InternAtom(win,name))
674 {
675 croak("%s/%ld is not a valid atom for %s\n",name,a,Tk_PathName(win));
676 }
677 }
678 }
679 }
680
681
682 int
SendClientMessage(win,type,xid,format,data)683 SendClientMessage(win,type,xid,format,data)
684 Tk_Window win
685 char * type
686 IV xid
687 IV format
688 SV * data
689 CODE:
690 {
691 XClientMessageEvent cM;
692 STRLEN len;
693 char *s = SvPV(data,len);
694 if (len > sizeof(cM.data))
695 len = sizeof(cM.data);
696 cM.type = ClientMessage;
697 cM.serial = 0;
698 cM.send_event = 0;
699 cM.display = Tk_Display(win);
700 cM.window = xid;
701 cM.message_type = Tk_InternAtom(win,type);
702 cM.format = format;
703 memmove(cM.data.b,s,len);
704 if ((RETVAL = XSendEvent(cM.display, cM.window, False, NoEventMask, (XEvent *) & cM)))
705 {
706 /* XSync may be overkill - but need XFlush ... */
707 XSync(cM.display, False);
708 }
709 else
710 {
711 croak("XSendEvent failed");
712 }
713 }
714 OUTPUT:
715 RETVAL
716
717 #if 0
718 int
719 SendNetWMClientMessage(win,type,xid,format,data)
720 Tk_Window win
721 char * type
722 IV xid
723 IV format
724 SV * data
725 CODE:
726 {
727 /*
728 It's not clear if this function should go into Perl/Tk. This
729 function would make is possible to send some netwm messages, for
730 example NET_WM_STATE_ABOVE:
731
732 my($wrapper) = $toplevel->wrapper;
733 my $_NET_WM_STATE_ADD = 1;
734 my $data = pack("LLLLL", $_NET_WM_STATE_ADD, $w->InternAtom('_NET_WM_STATE_ABOVE'), 0, 0, 0);
735 $w->SendNetWMClientMessage('_NET_WM_STATE', $wrapper, 32, $data);
736 */
737 XClientMessageEvent cM;
738 Window root = RootWindowOfScreen(Tk_Screen(win));
739 STRLEN len;
740 char *s = SvPV(data,len);
741 if (len > sizeof(cM.data))
742 len = sizeof(cM.data);
743 cM.type = ClientMessage;
744 cM.serial = 0;
745 cM.send_event = 0;
746 cM.display = Tk_Display(win);
747 cM.window = xid;
748 cM.message_type = Tk_InternAtom(win,type);
749 cM.format = format;
750 memmove(cM.data.b,s,len);
751 if ((RETVAL = XSendEvent(cM.display, root, False, SubstructureNotifyMask|SubstructureRedirectMask, (XEvent *) & cM)))
752 {
753 /* XSync may be overkill - but need XFlush ... */
754 XSync(cM.display, False);
755 }
756 else
757 {
758 croak("XSendEvent failed");
759 }
760 }
761 OUTPUT:
762 RETVAL
763
764 #endif
765
766 void
XSync(win,flush)767 XSync(win,flush)
768 Tk_Window win
769 int flush
770 CODE:
771 {
772 XSync(Tk_Display(win),flush);
773 }
774
775 void
Tk_GetRootCoords(win)776 Tk_GetRootCoords(win)
777 Tk_Window win
778 PPCODE:
779 {
780 int x, y;
781 Tk_GetRootCoords(win, &x, &y);
782 PUSHs(sv_2mortal(newSViv(x)));
783 PUSHs(sv_2mortal(newSViv(y)));
784 }
785
786 void
Tk_GetVRootGeometry(win)787 Tk_GetVRootGeometry(win)
788 Tk_Window win
789 PPCODE:
790 {
791 int x, y;
792 int width, height;
793 Tk_GetVRootGeometry(win, &x, &y, &width, &height);
794 PUSHs(sv_2mortal(newSViv(x)));
795 PUSHs(sv_2mortal(newSViv(y)));
796 PUSHs(sv_2mortal(newSViv(width)));
797 PUSHs(sv_2mortal(newSViv(height)));
798 }
799
800 Colormap
Tk_Colormap(win)801 Tk_Colormap(win)
802 Tk_Window win
803
804 Display *
805 Tk_Display(win)
806 Tk_Window win
807
808 int
809 Tk_ScreenNumber(win)
810 Tk_Window win
811
812 Screen *
813 Tk_Screen(win)
814 Tk_Window win
815
816 Visual *
817 Tk_Visual(win)
818 Tk_Window win
819
820 Window
821 Tk_WindowId(win)
822 Tk_Window win
823
824 int
825 Tk_X(win)
826 Tk_Window win
827
828 int
829 Tk_Y(win)
830 Tk_Window win
831
832 int
833 Tk_ReqWidth(win)
834 Tk_Window win
835
836 int
837 Tk_ReqHeight(win)
838 Tk_Window win
839
840 int
841 Tk_Width(win)
842 Tk_Window win
843
844 int
845 Tk_Height(win)
846 Tk_Window win
847
848 int
849 Tk_IsMapped(win)
850 Tk_Window win
851
852 int
853 Tk_Depth(win)
854 Tk_Window win
855
856 int
857 Tk_InternalBorderWidth(win)
858 Tk_Window win
859
860 int
861 Tk_IsTopLevel(win)
862 Tk_Window win
863
864 const char *
865 Tk_Name(win)
866 Tk_Window win
867
868 char *
869 Tk_PathName(win)
870 Tk_Window win
871
872 const char *
873 Tk_Class(win)
874 Tk_Window win
875
876 void
877 Tk_MakeWindowExist(win)
878 Tk_Window win
879
880 void
881 Tk_SetClass(win,class)
882 Tk_Window win
883 char * class
884
885 void
886 Tk_MoveWindow(win,x,y)
887 Tk_Window win
888 int x
889 int y
890
891 void
892 Tk_XRaiseWindow(win)
893 Tk_Window win
894
895 void
896 Tk_MoveToplevelWindow(win,x,y)
897 Tk_Window win
898 int x
899 int y
900 CODE:
901 {
902 TkWindow *winPtr = (TkWindow *) win;
903 if (!(winPtr->flags & TK_TOP_LEVEL))
904 {
905 croak("Tk_MoveToplevelWindow called with non-toplevel window");
906 }
907 Tk_MoveToplevelWindow(win,x,y);
908 }
909
910 void
Tk_MoveResizeWindow(win,x,y,width,height)911 Tk_MoveResizeWindow(win,x,y,width,height)
912 Tk_Window win
913 int x
914 int y
915 int width
916 int height
917
918 void
919 Tk_ResizeWindow(win,width,height)
920 Tk_Window win
921 int width
922 int height
923
924 void
925 Tk_GeometryRequest(win,width,height)
926 Tk_Window win
927 int width
928 int height
929
930 void
931 Tk_MaintainGeometry(slave,master,x,y,width,height)
932 Tk_Window slave
933 Tk_Window master
934 int x
935 int y
936 int width
937 int height
938
939 void
940 Tk_SetGrid(win,reqWidth,reqHeight,gridWidth,gridHeight)
941 Tk_Window win
942 int reqWidth
943 int reqHeight
944 int gridWidth
945 int gridHeight
946
947
948 void
949 Tk_UnmaintainGeometry(slave,master)
950 Tk_Window slave
951 Tk_Window master
952
953 void
954 Tk_MapWindow(win)
955 Tk_Window win
956
957 void
958 Tk_UnmapWindow(win)
959 Tk_Window win
960
961 void
962 Tk_UnsetGrid(win)
963 Tk_Window win
964
965 void
966 Tk_AddOption(win,name,value,priority)
967 Tk_Window win
968 char * name
969 char * value
970 int priority
971
972 const char *
973 Tk_GetAtomName(win,atom)
974 Tk_Window win
975 Atom atom
976
977 void
978 Tk_ClearSelection(win,selection)
979 Tk_Window win
980 Atom selection
981
982 const char *
983 Tk_DisplayName(win)
984 Tk_Window win
985
986 const char *
987 Tk_GetOption(win,name,class)
988 Tk_Window win
989 char * name
990 char * class
991
992 IV
993 Tk_InternAtom(win,name)
994 Tk_Window win
995 char * name
996
997 void
998 Tk_Ungrab(win)
999 Tk_Window win
1000
1001 const char *
1002 Tk_SetAppName(win,name)
1003 Tk_Window win
1004 char * name
1005
1006 int
1007 IsWidget(win)
1008 SV * win
1009 CODE:
1010 {
1011 if (!SvROK(win) || SvTYPE(SvRV(win)) != SVt_PVHV)
1012 RETVAL = 0;
1013 else
1014 {
1015 Lang_CmdInfo *info = WindowCommand(win,NULL,0);
1016 RETVAL = (info && info->tkwin);
1017 }
1018 }
1019 OUTPUT:
1020 RETVAL
1021
1022 int
Tk_Grab(win,global)1023 Tk_Grab(win,global)
1024 SV * win
1025 int global
1026 CODE:
1027 {
1028 Lang_CmdInfo *info = WindowCommand(win,NULL,3);
1029 RETVAL = Tk_Grab(info->interp,info->tkwin,global);
1030 }
1031
1032 SV *
Widget(win,path)1033 Widget(win,path)
1034 SV * win
1035 char * path
1036 CODE:
1037 {
1038 Lang_CmdInfo *info = WindowCommand(win,NULL,1);
1039 ST(0) = sv_mortalcopy(WidgetRef(info->interp,path));
1040 }
1041
1042 SV *
_object(win,name)1043 _object(win,name)
1044 SV * win
1045 char * name
1046 CODE:
1047 {
1048 Lang_CmdInfo *info = WindowCommand(win,NULL,1);
1049 ST(0) = sv_mortalcopy(ObjectRef(info->interp,name));
1050 }
1051
1052 Tk_Window
Containing(win,X,Y)1053 Containing(win,X,Y)
1054 Tk_Window win
1055 int X
1056 int Y
1057 CODE:
1058 {
1059 RETVAL = Tk_CoordsToWindow(X, Y, win);
1060 }
1061 OUTPUT:
1062 RETVAL
1063
1064 Tk_Window
Tk_Parent(win)1065 Tk_Parent(win)
1066 Tk_Window win
1067
1068 SV *
1069 MainWindow(interp)
1070 Tcl_Interp * interp
1071 CODE:
1072 {
1073 RETVAL = SvREFCNT_inc(WidgetRef(interp,"."));
1074 }
1075 OUTPUT:
1076 RETVAL
1077
1078 MODULE = Tk PACKAGE = Tk PREFIX = Tcl_
1079
1080 void
Tcl_AddErrorInfo(interp,message)1081 Tcl_AddErrorInfo(interp,message)
1082 Tcl_Interp * interp
1083 char * message
1084
1085 void
1086 Tcl_BackgroundError(interp)
1087 Tcl_Interp * interp
1088
1089 void
1090 Fail(interp,message)
1091 Tcl_Interp * interp
1092 char * message
1093 CODE:
1094 {
1095 Tcl_SetResult(interp,message,TCL_VOLATILE);
1096 Tcl_BackgroundError(interp);
1097 }
1098
1099 int
Tcl_DoOneEvent(...)1100 Tcl_DoOneEvent(...)
1101 CODE:
1102 {
1103 int flags = 0;
1104 if (items)
1105 {int i;
1106 for (i=0; i < items; i++)
1107 {
1108 SV *sv = ST(i);
1109 if (SvIOK(sv) || looks_like_number(sv))
1110 flags |= SvIV(sv);
1111 else if (!sv_isobject(sv))
1112 {STRLEN l;
1113 char *s = SvPV(sv,l);
1114 if (strcmp(s,BASEEXT))
1115 {
1116 /* string to integer lookup here */
1117 croak("Usage [$object->]DoOneEvent([flags]) got '%s'\n",s);
1118 }
1119 }
1120 }
1121 }
1122 RETVAL = Tcl_DoOneEvent(flags);
1123 }
1124 OUTPUT:
1125 RETVAL
1126
1127 MODULE = Tk PACKAGE = Tk::Font PREFIX = Font_
1128
1129 void
Font_DESTROY(sv)1130 Font_DESTROY(sv)
1131 SV * sv
1132
1133 MODULE = Tk PACKAGE = Tk::Font PREFIX = Tk_
1134
1135 int
1136 Tk_PostscriptFontName(tkfont,name)
1137 Tk_Font tkfont
1138 SV * &name
1139 OUTPUT:
1140 name
1141
1142 MODULE = Tk PACKAGE = Tk PREFIX = Lang_
1143
1144 SV *
1145 Lang_SystemEncoding()
1146
1147 MODULE = Tk PACKAGE = Tk PREFIX = Tk_
1148
1149
1150
1151 void
1152 abort()
1153
1154 int
1155 Tk_tainting()
1156
1157 int
1158 Tk_tainted(sv = NULL)
1159 SV * sv
1160
1161 void
1162 DebugHook(arg)
1163 SV * arg
1164
1165 void
1166 ClearErrorInfo(win)
1167 SV * win
1168
1169 BOOT:
1170 {
1171 Boot_Glue(aTHX);
1172 #ifdef WIN32
1173 /* Force inclusion of DllMain() */
1174 TkWin32DllPresent();
1175 TkWinXInit(Tk_GetHINSTANCE());
1176 #endif
1177 /* We need to call Tcl_Preserve() on something so
1178 its exit handler is first on the list, and so last
1179 to be called
1180 */
1181 Tcl_Preserve((ClientData) cv);
1182 Tcl_Release((ClientData) cv);
1183 }
1184
1185
1186
1187