1 /*
2  * tkMacOSXInit.c --
3  *
4  *	This file contains Mac OS X -specific interpreter initialization
5  *	functions.
6  *
7  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
8  * Copyright (c) 2001-2009, Apple Inc.
9  * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net>
10  * Copyright (c) 2017 Marc Culler
11  *
12  * See the file "license.terms" for information on usage and redistribution of
13  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
14  */
15 
16 #include "tkMacOSXPrivate.h"
17 #include <dlfcn.h>
18 #include <objc/objc-auto.h>
19 #include <sys/stat.h>
20 #include <sys/utsname.h>
21 
22 static char tkLibPath[PATH_MAX + 1] = "";
23 
24 /*
25  * If the App is in an App package, then we want to add the Scripts directory
26  * to the auto_path.
27  */
28 
29 static char scriptPath[PATH_MAX + 1] = "";
30 
31 /*
32  * Forward declarations...
33  */
34 
35 static int		TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip,
36 			    int objc, Tcl_Obj *const objv[]);
37 
38 #pragma mark TKApplication(TKInit)
39 
40 @implementation TKApplication
41 @synthesize poolLock = _poolLock;
42 @synthesize macOSVersion = _macOSVersion;
43 @synthesize isDrawing = _isDrawing;
44 @synthesize needsToDraw = _needsToDraw;
45 @end
46 
47 /*
48  * #define this to see a message on stderr whenever _resetAutoreleasePool is
49  * called while the pool is locked.
50  */
51 #undef DEBUG_LOCK
52 
53 @implementation TKApplication(TKInit)
54 - (void) _resetAutoreleasePool
55 {
56     if ([self poolLock] == 0) {
57 	[_mainPool drain];
58 	_mainPool = [NSAutoreleasePool new];
59     } else {
60 #ifdef DEBUG_LOCK
61 	fprintf(stderr, "Pool is locked with count %d!!!!\n", [self poolLock]);
62 #endif
63     }
64 }
65 - (void) _lockAutoreleasePool
66 {
67     [self setPoolLock:[self poolLock] + 1];
68 }
69 - (void) _unlockAutoreleasePool
70 {
71     [self setPoolLock:[self poolLock] - 1];
72 }
73 #ifdef TK_MAC_DEBUG_NOTIFICATIONS
74 - (void) _postedNotification: (NSNotification *) notification
75 {
76     TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification);
77 }
78 #endif
79 
80 - (void) _setupApplicationNotifications
81 {
82     NSNotificationCenter *nc = [NSNotificationCenter defaultCenter];
83 #define observe(n, s) \
84 	[nc addObserver:self selector:@selector(s) name:(n) object:nil]
85     observe(NSApplicationDidBecomeActiveNotification, applicationActivate:);
86     observe(NSApplicationWillResignActiveNotification, applicationDeactivate:);
87     observe(NSApplicationDidUnhideNotification, applicationShowHide:);
88     observe(NSApplicationDidHideNotification, applicationShowHide:);
89     observe(NSApplicationDidChangeScreenParametersNotification, displayChanged:);
90     observe(NSTextInputContextKeyboardSelectionDidChangeNotification, keyboardChanged:);
91 #undef observe
92 }
93 
94 -(void)applicationWillFinishLaunching:(NSNotification *)aNotification
95 {
96     (void)aNotification;
97 
98     /*
99      * Initialize notifications.
100      */
101 #ifdef TK_MAC_DEBUG_NOTIFICATIONS
102     [[NSNotificationCenter defaultCenter] addObserver:self
103 	    selector:@selector(_postedNotification:) name:nil object:nil];
104 #endif
105     [self _setupWindowNotifications];
106     [self _setupApplicationNotifications];
107 
108     if ([NSApp macOSVersion] >= 110000) {
109 
110    /*
111     * Initialize Apple Event processing. Apple's docs (see
112     * https://developer.apple.com/documentation/appkit/nsapplication)
113     * recommend doing this here, although historically we have
114     * done this in applicationWillFinishLaunching. In response to
115     * bug 7bb246b072.
116     */
117 
118     TkMacOSXInitAppleEvents(_eventInterp);
119 
120     }
121 }
122 
123 -(void)applicationDidFinishLaunching:(NSNotification *)notification
124 {
125     (void)notification;
126 
127    if ([NSApp macOSVersion] < 110000) {
128 
129    /*
130     * Initialize Apple Event processing on macOS versions
131     * older than Big Sur (11).
132     */
133 
134     TkMacOSXInitAppleEvents(_eventInterp);
135 
136     }
137 
138 
139     /*
140      * Initialize the graphics context.
141      */
142     TkMacOSXUseAntialiasedText(_eventInterp, -1);
143     TkMacOSXInitCGDrawing(_eventInterp, TRUE, 0);
144 
145     /*
146      * Construct the menu bar.
147      */
148 
149     _defaultMainMenu = nil;
150     [self _setupMenus];
151 
152     /*
153      * It is not safe to force activation of the NSApp until this method is
154      * called. Activating too early can cause the menu bar to be unresponsive.
155      * The call to activateIgnoringOtherApps was moved here to avoid this.
156      * However, with the release of macOS 10.15 (Catalina) that was no longer
157      * sufficient.  (See ticket bf93d098d7.)  The call to setActivationPolicy
158      * needed to be moved into this function as well.
159      */
160 
161     [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular];
162     [NSApp activateIgnoringOtherApps: YES];
163 
164     /*
165      * Process events to ensure that the root window is fully initialized. See
166      * ticket 56a1823c73.
167      */
168 
169     [NSApp _lockAutoreleasePool];
170     while (Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT)) {}
171     [NSApp _unlockAutoreleasePool];
172 }
173 
174 - (void) _setup: (Tcl_Interp *) interp
175 {
176     /*
177      * Remember our interpreter.
178      */
179     _eventInterp = interp;
180 
181     /*
182      * Install the global autoreleasePool.
183      */
184     _mainPool = [NSAutoreleasePool new];
185     [NSApp setPoolLock:0];
186 
187     /*
188      * Record the OS version we are running on.
189      */
190 
191     int minorVersion, majorVersion;
192 
193 #if MAC_OS_X_VERSION_MAX_ALLOWED < 101000
194     Gestalt(gestaltSystemVersionMinor, (SInt32*)&minorVersion);
195     majorVersion = 10;
196 #else
197     NSOperatingSystemVersion systemVersion;
198     systemVersion = [[NSProcessInfo processInfo] operatingSystemVersion];
199     majorVersion = systemVersion.majorVersion;
200     minorVersion = systemVersion.minorVersion;
201 #endif
202 
203     if (majorVersion == 10 && minorVersion == 16) {
204 
205 	/*
206 	 * If a program compiled with a macOS 10.XX SDK is run on macOS 11.0 or
207 	 * later then it will report majorVersion 10 and minorVersion 16, no
208 	 * matter what the actual OS version of the host may be. And of course
209 	 * Apple never released macOS 10.16. To work around this we guess the
210 	 * OS version from the kernel release number, as reported by uname.
211 	 */
212 
213 	struct utsname name;
214 	char *endptr;
215 	if (uname(&name) == 0) {
216 	    majorVersion = strtol(name.release, &endptr, 10) - 9;
217 	    minorVersion = 0;
218 	}
219     }
220     [NSApp setMacOSVersion: 10000*majorVersion + 100*minorVersion];
221 
222     /*
223      * We are not drawing right now.
224      */
225 
226     [NSApp setIsDrawing:NO];
227 
228     /*
229      * Be our own delegate.
230      */
231 
232     [self setDelegate:self];
233 
234     /*
235      * If no icon has been set from an Info.plist file, use the Wish icon from
236      * the Tk framework.
237      */
238 
239     NSString *iconFile = [[NSBundle mainBundle] objectForInfoDictionaryKey:
240 						    @"CFBundleIconFile"];
241     if (!iconFile) {
242 	NSString *path = [NSApp tkFrameworkImagePath:@"Tk.icns"];
243 	if (path) {
244 	    NSImage *image = [[NSImage alloc] initWithContentsOfFile:path];
245 	    if (image) {
246 		[image setName:@"NSApplicationIcon"];
247 		[NSApp setApplicationIconImage:image];
248 		[image release];
249 	    }
250 	}
251     }
252 }
253 
254 - (NSString *) tkFrameworkImagePath: (NSString *) image
255 {
256     NSString *path = nil;
257     NSAutoreleasePool *pool = [NSAutoreleasePool new];
258     if (tkLibPath[0] != '\0') {
259 	path = [[NSBundle bundleWithPath:[[NSString stringWithUTF8String:
260 		tkLibPath] stringByAppendingString:@"/../.."]]
261 		pathForImageResource:image];
262     }
263     if (!path) {
264 	const char *tk_library = Tcl_GetVar2(_eventInterp, "tk_library", NULL,
265 		TCL_GLOBAL_ONLY);
266 
267 	if (tk_library) {
268 	    NSFileManager *fm = [NSFileManager defaultManager];
269 
270 	    path = [[NSString stringWithUTF8String:tk_library]
271 		    stringByAppendingFormat:@"/%@", image];
272 	    if (![fm isReadableFileAtPath:path]) {
273 		path = [[NSString stringWithUTF8String:tk_library]
274 			stringByAppendingFormat:@"/../macosx/%@", image];
275 		if (![fm isReadableFileAtPath:path]) {
276 		    path = nil;
277 		}
278 	    }
279 	}
280     }
281 #ifdef TK_MAC_DEBUG
282     if (!path && getenv("TK_SRCROOT")) {
283 	path = [[NSString stringWithUTF8String:getenv("TK_SRCROOT")]
284 		stringByAppendingFormat:@"/macosx/%@", image];
285 	if (![[NSFileManager defaultManager] isReadableFileAtPath:path]) {
286 	    path = nil;
287 	}
288     }
289 #endif
290     [path retain];
291     [pool drain];
292     return path;
293 }
294 @end
295 
296 #pragma mark -
297 
298 /*
299  *----------------------------------------------------------------------
300  *
301  * TkpInit --
302  *
303  *	Performs Mac-specific interpreter initialization related to the
304  *	tk_library variable.
305  *
306  * Results:
307  *	Returns a standard Tcl result. Leaves an error message or result in
308  *	the interp's result.
309  *
310  * Side effects:
311  *	Sets "tk_library" Tcl variable, runs "tk.tcl" script.
312  *
313  *----------------------------------------------------------------------
314  */
315 
316 /*
317  * Helper function which closes the shared NSFontPanel and NSColorPanel.
318  */
319 
closePanels(void)320 static void closePanels(
321     void)
322 {
323     if ([NSFontPanel sharedFontPanelExists]) {
324 	[[NSFontPanel sharedFontPanel] orderOut:nil];
325     }
326     if ([NSColorPanel sharedColorPanelExists]) {
327         [[NSColorPanel sharedColorPanel] orderOut:nil];
328     }
329 }
330 
331 /*
332  * This custom exit procedure is called by Tcl_Exit in place of the exit
333  * function from the C runtime.  It calls the terminate method of the
334  * NSApplication class (superTerminate for a TKApplication).  The purpose of
335  * doing this is to ensure that the NSFontPanel and the NSColorPanel are closed
336  * before the process exits, and that the application state is recorded
337  * correctly for all termination scenarios.
338  *
339  * TkpWantsExitProc tells Tcl_AppInit whether to install our custom exit proc,
340  * which terminates the process by calling [NSApplication terminate].  This
341  * does not work correctly if the process is part of an exec pipeline, so it is
342  * only done if the process was launched by the launcher or if both stdin and
343  * stdout are ttys.  To disable using the custom exit proc altogether, undefine
344  * USE_CUSTOM_EXIT_PROC.
345  */
346 
347 #if defined(USE_CUSTOM_EXIT_PROC)
348 static Bool doCleanupFromExit = NO;
349 
TkpWantsExitProc(void)350 int TkpWantsExitProc(void) {
351     return doCleanupFromExit == YES;
352 }
353 
TkpExitProc(void * clientdata)354 TCL_NORETURN void TkpExitProc(
355     void *clientdata)
356 {
357     Bool doCleanup = doCleanupFromExit;
358     if (doCleanupFromExit) {
359 	doCleanupFromExit = NO; /* prevent possible recursive call. */
360 	closePanels();
361     }
362 
363     /*
364      * Tcl_Exit does not call Tcl_Finalize if there is an exit proc installed.
365      */
366 
367     Tcl_Finalize();
368     if (doCleanup == YES) {
369 	[(TKApplication *)NSApp superTerminate:nil]; /* Should not return. */
370     }
371     exit((long)clientdata); /* Convince the compiler that we don't return. */
372 }
373 #endif
374 
375 /*
376  * This signal handler is installed for the SIGINT, SIGHUP and SIGTERM signals
377  * so that normal finalization occurs when a Tk app is killed by one of these
378  * signals (e.g when ^C is pressed while running Wish in the shell).  It calls
379  * Tcl_Exit instead of the C runtime exit function called by the default handler.
380  * This is consistent with the Tcl_Exit manual page, which says that Tcl_Exit
381  * should always be called instead of exit.  When Tk is killed by a signal we
382  * return exit status 1.
383  */
384 
TkMacOSXSignalHandler(TCL_UNUSED (int))385 static void TkMacOSXSignalHandler(TCL_UNUSED(int)) {
386 
387     Tcl_Exit(1);
388 }
389 
390 int
TkpInit(Tcl_Interp * interp)391 TkpInit(
392     Tcl_Interp *interp)
393 {
394     static int initialized = 0;
395 
396     /*
397      * TkpInit can be called multiple times with different interpreters. But
398      * The application initialization should only be done onece.
399      */
400 
401     if (!initialized) {
402 	struct stat st;
403 	Bool shouldOpenConsole = NO;
404         Bool stdinIsNullish = (!isatty(0) &&
405 	    (fstat(0, &st) || (S_ISCHR(st.st_mode) && st.st_blocks == 0)));
406 
407 	/*
408 	 * Initialize/check OS version variable for runtime checks.
409 	 */
410 
411 #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060
412 #   error Mac OS X 10.6 required
413 #endif
414 
415 	initialized = 1;
416 
417 #ifdef TK_FRAMEWORK
418 
419 	/*
420 	 * When Tk is in a framework, force tcl_findLibrary to look in the
421 	 * framework scripts directory.
422 	 * FIXME: Should we come up with a more generic way of doing this?
423 	 */
424 
425 	if (Tcl_MacOSXOpenVersionedBundleResources(interp,
426 		"com.tcltk.tklibrary", TK_FRAMEWORK_VERSION, 0, PATH_MAX,
427 		tkLibPath) != TCL_OK) {
428             # if 0 /* This is not really an error.  Wish still runs fine. */
429 	    TkMacOSXDbgMsg("Tcl_MacOSXOpenVersionedBundleResources failed");
430 	    # endif
431 	}
432 #endif
433 
434 	/*
435 	 * Instantiate our NSApplication object. This needs to be done before
436 	 * we check whether to open a console window.
437 	 */
438 
439 	NSAutoreleasePool *pool = [NSAutoreleasePool new];
440 	[[NSUserDefaults standardUserDefaults] registerDefaults:
441 		[NSDictionary dictionaryWithObjectsAndKeys:
442 				  [NSNumber numberWithBool:YES],
443 			      @"_NSCanWrapButtonTitles",
444 				   [NSNumber numberWithInt:-1],
445 			      @"NSStringDrawingTypesetterBehavior",
446 			      nil]];
447 	[TKApplication sharedApplication];
448 	[pool drain];
449 
450         /*
451          * WARNING: The finishLaunching method runs asynchronously. This
452          * creates a race between the initialization of the NSApplication and
453          * the initialization of Tk.  If Tk wins the race bad things happen
454          * with the root window (see below).  If the NSApplication wins then an
455          * AppleEvent created during launch, e.g. by dropping a file icon on
456          * the application icon, will be delivered before the procedure meant
457          * to to handle the AppleEvent has been defined.  This is handled in
458          * tkMacOSXHLEvents.c by scheduling a timer event to handle the
459          * ApplEvent later, after the required procedure has been defined.
460          */
461 
462 	[NSApp _setup:interp];
463 	[NSApp finishLaunching];
464 
465         /*
466          * Create a Tk event source based on the Appkit event queue.
467          */
468 
469 	Tk_MacOSXSetupTkNotifier();
470 
471 	/*
472 	 * If Tk initialization wins the race, the root window is mapped before
473          * the NSApplication is initialized.  This can cause bad things to
474          * happen.  The root window can open off screen with no way to make it
475          * appear on screen until the app icon is clicked.  This will happen if
476          * a Tk application opens a modal window in its startup script (see
477          * ticket 56a1823c73).  In other cases, an empty root window can open
478          * on screen and remain visible for a noticeable amount of time while
479          * the Tk initialization finishes (see ticket d1989fb7cf).  The call
480          * below forces Tk to block until the Appkit event queue has been
481          * created.  This seems to be sufficient to ensure that the
482          * NSApplication initialization wins the race, avoiding these bad
483          * window behaviors.
484 	 */
485 
486 	Tcl_DoOneEvent(TCL_WINDOW_EVENTS | TCL_DONT_WAIT);
487 
488 	/*
489 	 * Decide whether to open a console window.  If the TK_CONSOLE
490 	 * environment variable is not defined we only show the console if
491 	 * stdin is not a tty and there is no startup script.
492 	 */
493 
494 	if (getenv("TK_CONSOLE")) {
495 	    shouldOpenConsole = YES;
496 	} else if (stdinIsNullish && Tcl_GetStartupScript(NULL) == NULL) {
497 	    const char *intvar = Tcl_GetVar2(interp, "tcl_interactive",
498 					     NULL, TCL_GLOBAL_ONLY);
499 	    if (intvar == NULL) {
500 		Tcl_SetVar2(interp, "tcl_interactive", NULL, "1",
501 			    TCL_GLOBAL_ONLY);
502 	    }
503 
504 #if defined(USE_CUSTOM_EXIT_PROC)
505 	    doCleanupFromExit = YES;
506 #endif
507 
508 	    shouldOpenConsole = YES;
509 	}
510 	if (shouldOpenConsole) {
511 	    Tk_InitConsoleChannels(interp);
512 	    Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDIN));
513 	    Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDOUT));
514 	    Tcl_RegisterChannel(interp, Tcl_GetStdChannel(TCL_STDERR));
515 	    if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
516 		return TCL_ERROR;
517 	    }
518 	} else if (stdinIsNullish) {
519 
520 	    /*
521 	     * When launched as a macOS application with no console,
522 	     * redirect stderr and stdout to /dev/null. This avoids waiting
523 	     * forever for those files to become writable if the underlying
524 	     * Tcl program tries to write to them with a puts command.
525 	     */
526 
527 	    FILE *null = fopen("/dev/null", "w");
528 	    dup2(fileno(null), STDOUT_FILENO);
529 	    dup2(fileno(null), STDERR_FILENO);
530 #if defined(USE_CUSTOM_EXIT_PROC)
531 	    doCleanupFromExit = YES;
532 #endif
533 	}
534 
535 	/*
536 	 * FIXME: Close stdin & stdout for remote debugging if XCNOSTDIN is
537 	 * set.  Otherwise we will fight with gdb for stdin & stdout
538 	 */
539 
540 	if (getenv("XCNOSTDIN") != NULL) {
541 	    close(0);
542 	    close(1);
543 	}
544 
545 	/*
546 	 * Initialize the NSServices object here. Apple's docs say to do this
547 	 * in applicationDidFinishLaunching, but the Tcl interpreter is not
548 	 * initialized until this function call.
549 	 */
550 
551 	TkMacOSXServices_Init(interp);
552 
553 	/*
554 	 * The root window has been created and mapped, but XMapWindow deferred its
555 	 * call to makeKeyAndOrderFront because the first call to XMapWindow
556 	 * occurs too early in the initialization process for that.  Process idle
557 	 * tasks now, so the root window is configured, then order it front.
558 	 */
559 
560 	while(Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {};
561 	for (NSWindow *window in [NSApp windows]) {
562 	    TkWindow *winPtr = TkMacOSXGetTkWindow(window);
563 	    if (winPtr && Tk_IsMapped(winPtr)) {
564 		[window makeKeyAndOrderFront:NSApp];
565 		break;
566 	    }
567 	}
568 
569 # if defined(USE_CUSTOM_EXIT_PROC)
570 
571 	if ((isatty(0) && isatty(1))) {
572 	    doCleanupFromExit = YES;
573 	}
574 
575 # endif
576 
577 	/*
578 	 * Install a signal handler for SIGINT, SIGHUP and SIGTERM which uses
579 	 * Tcl_Exit instead of exit so that normal cleanup takes place if a TK
580 	 * application is killed with one of these signals.
581 	 */
582 
583 	signal(SIGINT, TkMacOSXSignalHandler);
584 	signal(SIGHUP, TkMacOSXSignalHandler);
585 	signal(SIGTERM, TkMacOSXSignalHandler);
586     }
587 
588     /*
589      * Initialization steps that are needed for all interpreters.
590      */
591 
592     if (tkLibPath[0] != '\0') {
593 	Tcl_SetVar2(interp, "tk_library", NULL, tkLibPath, TCL_GLOBAL_ONLY);
594     }
595 
596     if (scriptPath[0] != '\0') {
597 	Tcl_SetVar2(interp, "auto_path", NULL, scriptPath,
598 		TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
599     }
600 
601     Tcl_CreateObjCommand(interp, "::tk::mac::standardAboutPanel",
602 	    TkMacOSXStandardAboutPanelObjCmd, NULL, NULL);
603     Tcl_CreateObjCommand(interp, "::tk::mac::iconBitmap",
604 	    TkMacOSXIconBitmapObjCmd, NULL, NULL);
605     Tcl_CreateObjCommand(interp, "::tk::mac::GetAppPath",
606 	    TkMacOSXGetAppPathCmd, NULL, NULL);
607 
608     return TCL_OK;
609 }
610 
611 /*
612  *----------------------------------------------------------------------
613  *
614  * TkpGetAppName --
615  *
616  *	Retrieves the name of the current application from a platform specific
617  *	location. For Unix, the application name is the tail of the path
618  *	contained in the tcl variable argv0.
619  *
620  * Results:
621  *	Returns the application name in the given Tcl_DString.
622  *
623  * Side effects:
624  *	None.
625  *
626  *----------------------------------------------------------------------
627  */
628 
629 void
TkpGetAppName(Tcl_Interp * interp,Tcl_DString * namePtr)630 TkpGetAppName(
631     Tcl_Interp *interp,
632     Tcl_DString *namePtr)	/* A previously initialized Tcl_DString. */
633 {
634     const char *p, *name;
635 
636     name = Tcl_GetVar2(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
637     if ((name == NULL) || (*name == 0)) {
638 	name = "tk";
639     } else {
640 	p = strrchr(name, '/');
641 	if (p != NULL) {
642 	    name = p+1;
643 	}
644     }
645     Tcl_DStringAppend(namePtr, name, -1);
646 }
647 
648 /*
649  *----------------------------------------------------------------------
650  *
651  * TkMacOSXGetAppPathCmd --
652  *
653  *	Returns the path of the Wish application bundle.
654  *
655  * Results:
656  *	Returns the application path.
657  *
658  * Side effects:
659  *	None.
660  *
661  *----------------------------------------------------------------------
662  */
663 
664 static int
TkMacOSXGetAppPathCmd(TCL_UNUSED (void *),Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])665 TkMacOSXGetAppPathCmd(
666     TCL_UNUSED(void *),
667     Tcl_Interp *interp,
668     int objc,
669     Tcl_Obj *const objv[])
670 {
671     if (objc != 1) {
672 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
673 	return TCL_ERROR;
674     }
675 
676     /*
677      * Get the application path URL and convert it to a string path reference.
678      */
679 
680     CFURLRef mainBundleURL = CFBundleCopyBundleURL(CFBundleGetMainBundle());
681     CFStringRef appPath =
682 	    CFURLCopyFileSystemPath(mainBundleURL, kCFURLPOSIXPathStyle);
683 
684     /*
685      * Convert (and copy) the string reference into a Tcl result.
686      */
687 
688     Tcl_SetObjResult(interp, Tcl_NewStringObj(
689 	    CFStringGetCStringPtr(appPath, CFStringGetSystemEncoding()), -1));
690 
691     CFRelease(mainBundleURL);
692     CFRelease(appPath);
693     return TCL_OK;
694 }
695 
696 /*
697  *----------------------------------------------------------------------
698  *
699  * TkpDisplayWarning --
700  *
701  *	This routines is called from Tk_Main to display warning messages that
702  *	occur during startup.
703  *
704  * Results:
705  *	None.
706  *
707  * Side effects:
708  *	Generates messages on stdout.
709  *
710  *----------------------------------------------------------------------
711  */
712 
713 void
TkpDisplayWarning(const char * msg,const char * title)714 TkpDisplayWarning(
715     const char *msg,		/* Message to be displayed. */
716     const char *title)		/* Title of warning. */
717 {
718     Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
719 
720     if (errChannel) {
721 	Tcl_WriteChars(errChannel, title, -1);
722 	Tcl_WriteChars(errChannel, ": ", 2);
723 	Tcl_WriteChars(errChannel, msg, -1);
724 	Tcl_WriteChars(errChannel, "\n", 1);
725     }
726 }
727 
728 /*
729  *----------------------------------------------------------------------
730  *
731  * TkMacOSXDefaultStartupScript --
732  *
733  *	On MacOS X, we look for a file in the Resources/Scripts directory
734  *	called AppMain.tcl and if found, we set argv[1] to that, so that the
735  *	rest of the code will find it, and add the Scripts folder to the
736  *	auto_path. If we don't find the startup script, we just bag it,
737  *	assuming the user is starting up some other way.
738  *
739  * Results:
740  *	None.
741  *
742  * Side effects:
743  *	Tcl_SetStartupScript() called when AppMain.tcl found.
744  *
745  *----------------------------------------------------------------------
746  */
747 
748 MODULE_SCOPE void
TkMacOSXDefaultStartupScript(void)749 TkMacOSXDefaultStartupScript(void)
750 {
751     NSAutoreleasePool *pool = [NSAutoreleasePool new];
752     CFBundleRef bundleRef = CFBundleGetMainBundle();
753 
754     if (bundleRef != NULL) {
755 	CFURLRef appMainURL = CFBundleCopyResourceURL(bundleRef,
756 		CFSTR("AppMain"), CFSTR("tcl"), CFSTR("Scripts"));
757 
758 	if (appMainURL != NULL) {
759 	    CFURLRef scriptFldrURL;
760 	    char startupScript[PATH_MAX + 1];
761 
762 	    if (CFURLGetFileSystemRepresentation(appMainURL, true,
763 		    (unsigned char *) startupScript, PATH_MAX)) {
764 		Tcl_SetStartupScript(Tcl_NewStringObj(startupScript,-1), NULL);
765 		scriptFldrURL = CFURLCreateCopyDeletingLastPathComponent(NULL,
766 			appMainURL);
767 		if (scriptFldrURL != NULL) {
768 		    CFURLGetFileSystemRepresentation(scriptFldrURL, true,
769 			    (unsigned char *) scriptPath, PATH_MAX);
770 		    CFRelease(scriptFldrURL);
771 		}
772 	    }
773 	    CFRelease(appMainURL);
774 	}
775     }
776     [pool drain];
777 }
778 
779 /*
780  *----------------------------------------------------------------------
781  *
782  * TkMacOSXGetNamedSymbol --
783  *
784  *	Dynamically acquire address of a named symbol from a loaded dynamic
785  *	library, so that we can use API that may not be available on all OS
786  *	versions.
787  *
788  * Results:
789  *	Address of given symbol or NULL if unavailable.
790  *
791  * Side effects:
792  *	None.
793  *
794  *----------------------------------------------------------------------
795  */
796 
797 MODULE_SCOPE void*
TkMacOSXGetNamedSymbol(TCL_UNUSED (const char *),const char * symbol)798 TkMacOSXGetNamedSymbol(
799     TCL_UNUSED(const char *),
800     const char *symbol)
801 {
802     void *addr = dlsym(RTLD_NEXT, symbol);
803 
804     if (!addr) {
805 	(void) dlerror(); /* Clear dlfcn error state */
806     }
807     return addr;
808 }
809 
810 /*
811  * Local Variables:
812  * mode: objc
813  * c-basic-offset: 4
814  * fill-column: 79
815  * coding: utf-8
816  * End:
817  */
818