Tk Source Code

.QW "YourApp Help"
performs the default Cocoa action of showing the Help Book configured in the
application's Info.plist (or displaying an alert if no Help Book is
set).
.TP
\fB::tk::mac::PerformService\fR
.
Executes a Tcl procedure called from the macOS 
.QW Services 
menu in the Application menu item. The
.QW Services
menu item allows for inter-application communication; data from one
application, such as selected text, can be sent to another application
for processing, for example to Safari as a search item for Google, or
to TextEdit to be appended to a file. An example of the proc is below,
and should be rewritten in an application script for customization: 
.RS
.PP
.CS
proc ::tk::mac::PerformService {} {
    set data [clipboard get]
    $w insert end $data
}
.CE
.RE
Note that the mechanism for retrieving the data is from the clipboard;
there is no other supported way to obtain the data.  If the Services 
process is not desired, the NSServices keys can be deleted from
the application's Info.plist file. The underlying code supporting this
command also allows the text, entry and ttk::entry widgets to access
services from other applications via the Services menu. The NSPortName
key in Wish's Info.plist file is currently set as
.QW "Wish"
; if a developer changes the name of the Wish executable to something
  else, this key should be modified with the same name.
.TP
\fB::tk::mac::LaunchURL \fIURL...\fR
.
If defined, launches a URL within Tk. This would be used if a Tk
application wants to handle a URL itself, such as displaying data from
an RSS feed, rather than launching a default application to handle the
URL, although it can defined as such. Wish includes a stub URL scheme
of
.QW foo://
in the CFBundleURLSchemes key of its Info.plist file; this should be customized for the specific URL
scheme the developer wants to support. 
.TP
\fB::tk::mac::GetAppPath\fR
.
Returns the current applications's file path.
.TP

	set Priv(y) $y
    }
    if {($x != $Priv(x)) || ($y != $Priv(y))} {
	set Priv(mouseMoved) 1
    }
    if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
	$w scan dragto $x $y
    }  
}

# ::tk::TextUndoRedoProcessMarks --
#
# This proc is executed after an undo or redo action.
# It processes the list of undo/redo marks temporarily set in the
# text widget to positions delimiting where changes happened, and

	if {$length > $maxlen} {
	    set maxlen $length
	}
    }
    return $maxlen
}

# For now, turn off the custom mdef proc for the mac:

if {[tk windowingsystem] eq "aqua"} {
    namespace eval ::tk::mac {
	set useCustomMDEF 0
    }
}

#register to send data to macOS Services
if {[tk windowingsystem] eq "aqua"} {
proc ::tk::RegisterServiceWidget {w} {
    ::tk::mac::registerServiceWidget $w
  }
}


# Run the Ttk themed widget set initialization
if {$::ttk::library ne ""} {
    uplevel \#0 [list source $::ttk::library/ttk.tcl]
}

# Local Variables:

time in the past.  In that case the Tk build directory will contain
its own copy of Wish.app that will be visible to LaunchServices.  It
may be necessary when testing your app to take some steps to ensure
that LaunchServices is launching the correct Wish.app.  Instructions
for doing this are provided below.

The command line tool which manages the LaunchServices database has
an amazingly unwieldy path name.  So, first, run this command: 

alias lsregister='/System/Library/Frameworks/CoreServices.framework/Versions/A/Frameworks/LaunchServices.framework/Versions/A/Support/lsregister'

Then you can reset the LaunchServices database like this:

$ lsregister -kill
$ lsregister -seed

			 stringValue];
    const char *printFile = [file UTF8String];
    Tcl_DString print;

    Tcl_DStringInit(&print);
    if (Tcl_FindCommand(_eventInterp, "::tk::mac::PrintDocument", NULL, 0)) {
	Tcl_DStringAppend(&print, "::tk::mac::PrintDocument", -1);
    } 
    Tcl_DStringAppendElement(&print, printFile);
    int tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&print),
	    Tcl_DStringLength(&print), TCL_EVAL_GLOBAL);
    if (tclErr != TCL_OK) {
	Tcl_BackgroundException(_eventInterp, tclErr);
    }
}

                        stringValue];
    const char *cURL = [url UTF8String];
    Tcl_DString launch;

    Tcl_DStringInit(&launch);
    if (Tcl_FindCommand(_eventInterp, "::tk::mac::LaunchURL", NULL, 0)) {
	Tcl_DStringAppend(&launch, "::tk::mac::LaunchURL", -1);
    } 
    Tcl_DStringAppendElement(&launch, cURL);
    int tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&launch),
	    Tcl_DStringLength(&launch), TCL_EVAL_GLOBAL);
    if (tclErr != TCL_OK) {
	Tcl_BackgroundException(_eventInterp, tclErr);
    }
}

	[aeManager setEventHandler:NSApp
	    andSelector:@selector(handleDoScriptEvent:withReplyEvent:)
	    forEventClass:kAEMiscStandards andEventID:kAEDoScript];

	[aeManager setEventHandler:NSApp
	    andSelector:@selector(handleURLEvent:withReplyEvent:)
	    forEventClass:kInternetEventClass andEventID:kAEGetURL];
	
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacOSXDoHLEvent --

	    TkMacOSXRegisterServiceWidgetObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tk::mac::iconBitmap",
	    TkMacOSXIconBitmapObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tk::mac::GetAppPath", TkMacOSXGetAppPath,(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

    /*
     * Initialize the NSServices object here. Apple's docs say to do this
     * in applicationDidFinishLaunching, but the Tcl interpreter is not 
     * initialized until this function call. 
     */
    
    TkMacOSXServices_Init(interp);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

		       Tcl_Interp *ip,
		       int objc,
		       Tcl_Obj *CONST objv[])
{

  CFURLRef mainBundleURL = CFBundleCopyBundleURL(CFBundleGetMainBundle());

  
  /* 
   * Convert the URL reference into a string reference. 
   */
  
  CFStringRef appPath = CFURLCopyFileSystemPath(mainBundleURL, kCFURLPOSIXPathStyle);
 
  /* 
   * Get the system encoding method. 
   */
  
  CFStringEncoding encodingMethod = CFStringGetSystemEncoding();
 
  /* 
   * Convert the string reference into a C string. 
   */
  
  char *path = (char *) CFStringGetCStringPtr(appPath, encodingMethod);

  Tcl_SetResult(ip, path, NULL);

  CFRelease(mainBundleURL);
  CFRelease(appPath);
  return TCL_OK;

    *buffer = '\0';

    /*
     * Depending on the platform, turn the data into Unicode or the system
     * encoding before placing it on the clipboard.
     */

#ifdef UNICODE
	Tcl_DStringInit(&ds);
	Tcl_UtfToUniCharDString(rawText, -1, &ds);
	ckfree(rawText);
	handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
		(unsigned) Tcl_DStringLength(&ds) + 2);
	if (!handle) {
	    Tcl_DStringFree(&ds);
	    return;
	}
	buffer = GlobalLock(handle);
	memcpy(buffer, Tcl_DStringValue(&ds),
		(unsigned) Tcl_DStringLength(&ds) + 2);
	GlobalUnlock(handle);
	Tcl_DStringFree(&ds);
	SetClipboardData(CF_UNICODETEXT, handle);
#else
	Tcl_UtfToExternalDString(NULL, rawText, -1, &ds);
	ckfree(rawText);
	handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
		(unsigned) Tcl_DStringLength(&ds) + 1);
	if (!handle) {
	    Tcl_DStringFree(&ds);
	    return;
	}
	buffer = GlobalLock(handle);
	memcpy(buffer, Tcl_DStringValue(&ds),
		(unsigned) Tcl_DStringLength(&ds) + 1);
	GlobalUnlock(handle);
	Tcl_DStringFree(&ds);
	SetClipboardData(CF_TEXT, handle);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TkSelUpdateClipboard --
 *

/* This "new" dialog style is now actually the "old" dialog style post-Vista */
#ifndef BIF_NEWDIALOGSTYLE
#define BIF_NEWDIALOGSTYLE 0x0040
#endif

#ifndef BFFM_VALIDATEFAILED
#ifdef UNICODE
#define BFFM_VALIDATEFAILED 4
#else
#define BFFM_VALIDATEFAILED 3
#endif
#endif /* BFFM_VALIDATEFAILED */

typedef struct ThreadSpecificData {
    int debugFlag;		/* Flags whether we should output debugging
				 * information while displaying a builtin
				 * dialog. */
    Tcl_Interp *debugInterp;	/* Interpreter to used for debugging. */

	 * some other location.
	 */

	encoding = Tcl_GetEncoding(NULL, faceName);
    }

    if (encoding == NULL) {
	encoding = Tcl_GetEncoding(NULL, "unicode");
	familyPtr->textOutProc =
	    (BOOL (WINAPI *)(HDC, int, int, WCHAR *, int)) TextOutW;
	familyPtr->getTextExtentPoint32Proc =
	    (BOOL (WINAPI *)(HDC, WCHAR *, int, LPSIZE)) GetTextExtentPoint32W;
	familyPtr->isWideFont = 1;
    } else {
	familyPtr->textOutProc =

Tcl_Obj*
TkWin32ErrorObj(
    HRESULT hrError)
{
    LPTSTR lpBuffer = NULL, p = NULL;
    WCHAR  sBuffer[30];
    Tcl_Obj* errPtr = NULL;
#ifdef _UNICODE
    Tcl_DString ds;
#endif

    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError,
	    LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);

    if (lpBuffer == NULL) {
	lpBuffer = sBuffer;
	wsprintf(sBuffer, L"Error Code: %08lX", hrError);
    }

    if ((p = wcsrchr(lpBuffer, L'\r')) != NULL) {
	*p = L'\0';
    }

#ifdef _UNICODE
    Tcl_DStringInit(&ds);
    Tcl_UniCharToUtfDString(lpBuffer, wcslen(lpBuffer), &ds);
    errPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
#else
    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
#endif /* _UNICODE */

    if (lpBuffer != sBuffer) {
	LocalFree((HLOCAL)lpBuffer);
    }

    return errPtr;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:

 */

#ifndef GetClassLongPtr
#   define GetClassLongPtrA	GetClassLongA
#   define GetClassLongPtrW	GetClassLongW
#   define SetClassLongPtrA	SetClassLongA
#   define SetClassLongPtrW	SetClassLongW
#   ifdef UNICODE
#	define GetClassLongPtr	GetClassLongPtrW
#	define SetClassLongPtr	SetClassLongPtrW
#   else
#	define GetClassLongPtr	GetClassLongPtrA
#	define SetClassLongPtr	SetClassLongPtrA
#   endif /* !UNICODE */
#endif /* !GetClassLongPtr */
#ifndef GCLP_HICON
#   define GCLP_HICON		GCL_HICON
#endif /* !GCLP_HICON */
#ifndef GCLP_HICONSM
#   define GCLP_HICONSM		(-34)
#endif /* !GCLP_HICONSM */

#ifndef GetWindowLongPtr
#   define GetWindowLongPtrA	GetWindowLongA
#   define GetWindowLongPtrW	GetWindowLongW
#   define SetWindowLongPtrA	SetWindowLongA
#   define SetWindowLongPtrW	SetWindowLongW
#   ifdef UNICODE
#	define GetWindowLongPtr	GetWindowLongPtrW
#	define SetWindowLongPtr	SetWindowLongPtrW
#   else
#	define GetWindowLongPtr	GetWindowLongPtrW
#	define SetWindowLongPtr	SetWindowLongPtrW
#   endif /* !UNICODE */
#endif /* !GetWindowLongPtr */
#ifndef GWLP_WNDPROC
#define GWLP_WNDPROC		GWL_WNDPROC
#define GWLP_HINSTANCE		GWL_HINSTANCE
#define GWLP_HWNDPARENT		GWL_HWNDPARENT
#define GWLP_USERDATA		GWL_USERDATA
#define GWLP_ID			GWL_ID

	if (error == ERROR_CALL_NOT_IMPLEMENTED) {
	    strcpy(msgBuf, "function not supported under Win32s");
	} else {
	    sprintf(msgBuf, "unknown error: %ld", error);
	}
	msg = msgBuf;
    } else {
	Tcl_Encoding encoding;
	char *msgPtr;

	encoding = Tcl_GetEncoding(NULL, "unicode");
	Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
	Tcl_FreeEncoding(encoding);
	LocalFree(wMsgPtr);

	msgPtr = Tcl_DStringValue(&ds);
	length = Tcl_DStringLength(&ds);

	/*
	 * Trim the trailing CR/LF from the system message.