Changes On Branch apn-init-refactor
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch apn-init-refactor Excluding Merge-Ins

This is equivalent to a diff from 335229fa9c to d603862aae

2025-10-30
10:25
Start on TIP 732 implementation check-in: 36a0154331 user: apnadkarni tags: tip-732
2025-10-27
11:42
Clean up guts of hidden command invoking to shorten code paths; TclObjInvoke remains for stubs compa... check-in: e9608db1b3 user: dkf tags: trunk, main
11:21
merge trunk check-in: b6defdba67 user: dkf tags: cleanup-objinvoke
08:13
Merge trunk Leaf check-in: d603862aae user: apnadkarni tags: apn-init-refactor
2025-10-26
22:31
Eliminate compiler warning (only seen in DEBUG) check-in: 335229fa9c user: jan.nijtmans tags: trunk, main
11:33
On MSVC, <stdbool.h> is always needed, apparently check-in: 6bf02a0e78 user: jan.nijtmans tags: trunk, main
2025-10-04
15:56
Don't delete InitAutoPath command after use. safe::interp tests load init.tcl multiple times check-in: aaa58a200a user: apnadkarni tags: apn-init-refactor

Changes to generic/tclInt.h.
3420
3421
3422
3423
3424
3425
3426



3427
3428
3429
3430
3431
3432
3433
MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void	TclFinalizeThreadData(int quick);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
MODULE_SCOPE double	TclFloor(const void *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, Tcl_Size *indexPtr);



MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData, Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);







>
>
>







3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void	TclFinalizeThreadData(int quick);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
MODULE_SCOPE double	TclFloor(const void *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, Tcl_Size *indexPtr);
MODULE_SCOPE int TclFSGetAncestorPaths(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_Size numPaths, Tcl_Obj *pathsPtrs[]);

MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData, Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
3713
3714
3715
3716
3717
3718
3719

3720
3721


3722
3723
3724
3725
3726
3727
3728
MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, Tcl_Size length);
/* Tip 430 */
MODULE_SCOPE int	TclZipfs_Init(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsZipfsPath(const char *path);
MODULE_SCOPE void	TclZipfsFinalize(void);

MODULE_SCOPE Tcl_Obj *	TclGetObjNameOfShlib(void);
MODULE_SCOPE void	TclSetObjNameOfShlib(Tcl_Obj *namePtr, Tcl_Encoding);



/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
 * optimization (fragile on changes) in one place.
 */








>


>
>







3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, Tcl_Size length);
/* Tip 430 */
MODULE_SCOPE int	TclZipfs_Init(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsZipfsPath(const char *path);
MODULE_SCOPE void	TclZipfsFinalize(void);

MODULE_SCOPE Tcl_Obj *	TclGetObjNameOfShlib(void);
MODULE_SCOPE void	TclSetObjNameOfShlib(Tcl_Obj *namePtr, Tcl_Encoding);
MODULE_SCOPE Tcl_Size	TclGetObjExecutableAncestors(Tcl_Interp *interp,
			    Tcl_Size numPaths, Tcl_Obj *pathsPtr[]);

/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
 * optimization (fragile on changes) in one place.
 */

Changes to generic/tclInterp.c.
8
9
10
11
12
13
14

15
16
17
18
19
20
21
 * Copyright © 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
 * above. This variable can be modified by the function below.
 */








>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright © 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>

/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
 * above. This variable can be modified by the function below.
 */

275
276
277
278
279
280
281




282
283
284
285
286
287
288
static void		CallScriptLimitCallback(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(void *clientData);
static void		MakeSafe(Tcl_Interp *interp);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(void *clientData);





/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;

/*







>
>
>
>







276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
static void		CallScriptLimitCallback(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(void *clientData);
static void		MakeSafe(Tcl_Interp *interp);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(void *clientData);
static int		RunPreInitScript(Tcl_Interp *interp);
static Tcl_Obj *	LocatePreInitScript(Tcl_Interp *interp);
static Tcl_ObjCmdProc	InitAutoPathObjCmd;
#define INIT_AUTO_PATH_CMD "::tcl::InitAutoPath"

/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;

/*
307
308
309
310
311
312
313







































































































































































































































































































































































































































314
315
316
317
318
319
320
    const char *string)		/* Pointer to a script. */
{
    const char *prevString = tclPreInitScript;
    tclPreInitScript = string;
    return prevString;
}








































































































































































































































































































































































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_Init --
 *
 *	This function is typically invoked by Tcl_AppInit functions to find
 *	and source the "init.tcl" script, which should exist somewhere on the







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
    const char *string)		/* Pointer to a script. */
{
    const char *prevString = tclPreInitScript;
    tclPreInitScript = string;
    return prevString;
}

/*
 * CheckForFileInDir --
 *
 * Little helper to check if a file exists within a directory and is readable.
 *
 * Results:
 *	Returns path to the file if it exists, NULL if not. Reference count
 *	of returned Tcl_Obj is incremented before returning to account for the
 *      caller owning a reference.
 */
static Tcl_Obj *
CheckForFileInDir(
    Tcl_Obj *dirPathPtr,
    Tcl_Obj *fileNamePtr)
{
    Tcl_Obj *path[2];
    path[0] = dirPathPtr;
    path[1] = fileNamePtr;
    Tcl_Obj *fullPathPtr = TclJoinPath(2, path, 0);
    Tcl_IncrRefCount(fullPathPtr);
    if (Tcl_FSAccess(fullPathPtr, R_OK) == 0) {
	return fullPathPtr;
    }
    Tcl_DecrRefCount(fullPathPtr);
    return NULL;
}

/*
 * LocatePreInitScript --
 *
 *	Locates the Tcl initialization script, "init.tcl".
 *
 * Results:
 *	Returns a Tcl_Obj containing the path or NULL if not found.
 *	Reference count of returned Tcl_Obj is incremented before returning
 *	to account for the caller owning a reference.
 *
 * Side effects:
 *	Sets the tcl_library variable to the directory containing init.tcl.
 */
Tcl_Obj *
LocatePreInitScript(Tcl_Interp *interp)
{
    /*
     * The search order for the init.tcl is as follows:
     *
     * $tcl_library -
     * Can specify a primary location, if set, no other locations will be
     * checked. This is the recommended way for a program that embeds Tcl
     * to specifically tell Tcl where to find an init.tcl file.
     *
     * $env(TCL_LIBRARY) -
     * Highest priority so user can always override the search path unless
     * the application has specified an exact directory above
     *
     * $tclDefaultLibrary -
     * INTERNAL: This variable is set by Tcl on those platforms where it
     * can determine at runtime the directory where it expects the init.tcl
     * file to be. If set, this value is unset after use. External users of
     * Tcl should not make use of the variable to customize this function.
     *
     * [tcl::pkgconfig get scriptdir,runtime] -
     * The directory determined by configure to be the place where Tcl's
     * script library is to be installed.
     *
     * ancestor directories of the executable -
     * The lib and library subdirectories of the parent and grand-parent
     * directories of the directory containing the executable.
     *
     * The first directory on this path that contains a init.tcl script
     * will be set as the value of tcl_library and the init.tcl file sourced.
     *
     * Note the following differences from Tcl 9.0 where this functionality
     * was implemented as a Tcl script.
     *
     * - the $tcl_libPath variable is no longer used. It was maked OBSOLETE
     *   and not supposed to be used. Applications that embed Tcl and want
     *   to customize should set tcl_library or call Tcl_PreInitScript
     *   instead.
     */

    Tcl_Obj *dirPtr;
    Tcl_Obj *searchedDirs;
    Tcl_Obj *initScriptPathPtr = NULL;
    Tcl_Obj *ancestors[2] = {NULL, NULL};
    Tcl_Obj *literals[] = {NULL, NULL, NULL, NULL, NULL};
    enum { INITLIT, VERSIONLIT, PATCHLIT, LIBLIT, LIBRARYLIT };

    /*
     * Need to track checked directories for error reporting. As a side
     * benefit, because they are tracked here we can keep overwriting dirPtr
     * without leaking memory.
     */
    searchedDirs = Tcl_NewListObj(0, NULL);

    literals[INITLIT] = Tcl_NewStringObj("init.tcl", 8);
    Tcl_IncrRefCount(literals[INITLIT]);

    dirPtr = Tcl_GetVar2Ex(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    if (dirPtr != NULL) {
	Tcl_ListObjAppendElement(NULL, searchedDirs, dirPtr);
	initScriptPathPtr = CheckForFileInDir(dirPtr, literals[INITLIT]);
	/*
	 * As per documentation and historical behavior do not search further
	 * even on failure in the case of tcl_library being set.
	 */
	goto done;
    }

    /*
     * For remaining paths, failure means we just go on to the next one.
     * Would be more elegant to use a loop over possible paths and check
     * file existence in the body but that means paths that never get used
     * are constructed. Instead we use a macro to reduce code duplication.
     */
#define TRY_PATH(dirarg_)                                         \
    do {                                                          \
	dirPtr = (dirarg_);                                       \
	if (dirPtr) {                                             \
	    Tcl_ListObjAppendElement(NULL, searchedDirs, dirPtr); \
	    /* Tcl_IsEmpty check - bug 465d4546e2 */              \
	    if (!Tcl_IsEmpty(dirPtr)) {                           \
		initScriptPathPtr =                               \
		    CheckForFileInDir(dirPtr, literals[INITLIT]); \
		if (initScriptPathPtr != NULL) {                  \
		    goto done;                                    \
		}                                                 \
	    }                                                     \
	}                                                         \
    } while (0)

    /*
     * As documented, we do not check subdirectories of TCL_LIBRARY.
     * This differs from the behavior of tcl 9.0.
     */
    TRY_PATH(Tcl_GetVar2Ex(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY));

    TRY_PATH(TclZipfs_TclLibrary());

    TRY_PATH(Tcl_GetVar2Ex(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY));
    if (dirPtr == NULL) {
	/*
	 * tcl::pkgconfig get scriptdir,runtime. Why only if
	 * tclDefaultLibrary is not set? Historical compatibility
	 */
#ifdef CFG_RUNTIME_SCRDIR
	TRY_PATH(Tcl_NewStringObj(CFG_RUNTIME_SCRDIR, -1));
#endif
    }

    assert(initScriptPathPtr == NULL);

    /*
     * Now try ancestor directories of the executable. If "parent" is the
     * parent of the directory containing the exe, paths are searched
     * in the following order in the original Tcl 9.0 implementation:
     *   1. parent/lib/tclVERSION
     *   2. parent/../lib/tclVERSION
     *   3. parent/library
     *   4. parent/../library
     *   5. parent/../tclVERSION/library
     *   6. parent/../tclPATCHLEVEL/library
     *   7. parent/../../tclPATCHLEVEL/library
     * Heck! Why not search the whole damn disk!
     * Pending further discussion, we only do 1-4, and further always
     * prioritize parent over grandparent.
     */

    literals[VERSIONLIT] = Tcl_NewStringObj("tcl" TCL_VERSION, -1);
    Tcl_IncrRefCount(literals[VERSIONLIT]);
    literals[LIBLIT] = Tcl_NewStringObj("lib", 3);
    Tcl_IncrRefCount(literals[LIBLIT]);
    literals[LIBRARYLIT] = Tcl_NewStringObj("library", 7);
    Tcl_IncrRefCount(literals[LIBRARYLIT]);

    /* Reminder - TclGetObjNameOfExecutable return need not be released */
    Tcl_Obj *exePtr = TclGetObjNameOfExecutable();
    if (exePtr == NULL) {
	goto done;
    }
    exePtr = TclPathPart(interp, exePtr, TCL_PATH_DIRNAME);
    if (exePtr == NULL) {
	goto done;
    }
    ancestors[0] = TclPathPart(interp, exePtr, TCL_PATH_DIRNAME);
    Tcl_DecrRefCount(exePtr);
    if (ancestors[0] == NULL) {
	goto done;
    }
    ancestors[1] = TclPathPart(interp, ancestors[0], TCL_PATH_DIRNAME);
    if (ancestors[1] == NULL) {
	goto done;
    }
    /*
     * Note: ancestors[] are freed at function end. TclPathPart returns
     * Tcl_Obj with ref count incremented so do not incr ref it here.
     */

    Tcl_Obj *paths[3];
    for (size_t i = 0; i < sizeof(ancestors) / sizeof(ancestors[0]); ++i) {
	paths[0] = ancestors[i];
	paths[1] = literals[LIBLIT];
	paths[2] = literals[VERSIONLIT];
	TRY_PATH(TclJoinPath(3, paths, 0));

	paths[1] = literals[LIBRARYLIT];
	TRY_PATH(TclJoinPath(2, paths, 0));
    }

done: /* initScriptPtr != NULL => dirPtr holds dir of init.tcl */
    if (initScriptPathPtr == NULL) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf(
		"Cannot find a usable init.tcl in the following directories: \n"
		"    %s\n\n"
		"This probably means that Tcl wasn't installed properly.\n",
		Tcl_GetString(searchedDirs)));
    } else {
	Tcl_SetVar2Ex(interp, "tcl_library", NULL, dirPtr, TCL_GLOBAL_ONLY);
    }
    for (size_t i = 0; i < sizeof(ancestors) / sizeof(ancestors[0]); ++i) {
	if (ancestors[i]) {
	    Tcl_DecrRefCount(ancestors[i]);
	}
    }
    for (size_t i = 0; i < sizeof(literals)/sizeof(literals[0]); i++) {
	if (literals[i] != NULL) {
	    Tcl_DecrRefCount(literals[i]);
	}
    }
    /* Note all examined dirPtr values get freed with searchedDirs */
    Tcl_DecrRefCount(searchedDirs);
    return initScriptPathPtr;
#undef TRY_PATH
}

/*
 * RunPreInitScript --
 *
 *	Locates and invokes the Tcl initialization script, "init.tcl".
 *
 * Results:
 *	Returns a standard Tcl completion code.
 *
 * Side effects:
 *	Pretty much anything, depending on the contents of the script.
 */
int
RunPreInitScript(Tcl_Interp *interp)
{
    /*
     * Note the following differences from 9.0. If a init.tcl is found and
     * sourced, further directories are NOT searched even if the init.tcl
     * sourcing raised errors. This is by design as it is indicative of some
     * configuration error and attempting a fix through trial and error is
     * not a robust solution.
     *
     * Further, this search mechanism cannot be bypassed by defining an
     * alternate tclInit command before calling Tcl_Init() as was the case
     * in Tcl 9.0. Use the Tcl_SetPreInitScript function to instead.
     */
    Tcl_Obj *initScriptPathPtr = LocatePreInitScript(interp);
    /* Note initScriptPathPtr reference count already incremented */
    if (initScriptPathPtr == NULL) {
	return TCL_ERROR;
    }
    int result = Tcl_FSEvalFile(interp, initScriptPathPtr);
    Tcl_DecrRefCount(initScriptPathPtr);
    if (result != TCL_OK) {
	Tcl_ObjPrintf("Error sourcing Tcl initialization script from %s:\n%s",
	    Tcl_GetString(initScriptPathPtr),
	    Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return result;
}

int
AddPathsInVarToList(
	Tcl_Interp *interp,
	const char *name1,
	const char *name2,
	Tcl_Obj *toListPtr,
	int doTildeExpand
)
{
    Tcl_Obj **elems;
    Tcl_Size nelems;
    Tcl_Obj *fromListPtr= Tcl_GetVar2Ex(interp, name1, name2, TCL_GLOBAL_ONLY);
    if (fromListPtr) {
	if (TclListObjGetElements(interp, fromListPtr, &nelems, &elems) !=
	    TCL_OK) {
	    return TCL_ERROR;
	}
	for (Tcl_Size i = 0; i < nelems; ++i) {
	    Tcl_Obj *pathPtr = elems[i];
	    if (doTildeExpand) {
		pathPtr = TclResolveTildePath(NULL, pathPtr);
		if (pathPtr == NULL) {
		    continue;
		}
	    }
            /* Note: TclListObjAppendIfAbsent handles 0 and non-0 ref counts */
	    if (TclListObjAppendIfAbsent(interp, toListPtr, pathPtr) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

/*
 * InitAutoPathObjCmd --
 *
 *	Initializes the auto_path variable in an interpreter. In safe interps,
 *	it is set to empty. In unsafe interps, the following are added to it
 *
 *	- If auto_path does not exist, it is initialized with the content
 *	  of the TCLLIBPATH environment variable with tilde expansion
 *	- The tcl_library directory and its parent
 *	- The lib subdirectory in the parent directory of the directory
 *	  containing the executable
 *	- The elements of tcl_pkgPath
 *
 *	The function also adds the encoding subdirectory of tcl_library
 *	to the encodings search path if not already present.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The command deletes itself as it should not be called more than once
 *	for an interpreter.
 */
int
InitAutoPathObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }
    Tcl_Obj *autoPathPtr;

    autoPathPtr = Tcl_GetVar2Ex(interp, "auto_path", NULL, TCL_GLOBAL_ONLY);

    /* Safe interps get empty auto_path if it does not exist. */
    if (Tcl_IsSafe(interp)) {
	if (autoPathPtr == NULL) {
	    Tcl_SetVar2Ex(interp, "auto_path", NULL, Tcl_NewObj(),
		TCL_GLOBAL_ONLY);
	}
	return TCL_OK;
    }

    /*
     * Paths are added only if they do not exist. N**2 complexity but lengths
     * should be short so not worth hashed lookups.
     */

    int result;

    /* Initialize from TCLLIBPATH only if auto_path did not already exist */
    if (autoPathPtr == NULL) {
	autoPathPtr = Tcl_NewObj();
	if (AddPathsInVarToList(interp, "env", "TCLLIBPATH", autoPathPtr, 1) != TCL_OK) {
	    Tcl_DecrRefCount(autoPathPtr);
	    return TCL_ERROR;
	}
    }

    /* tcl_library and its parent */
    Tcl_Obj *objPtr =
	Tcl_GetVar2Ex(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    if (objPtr) {
	if (TclListObjAppendIfAbsent(interp, autoPathPtr, objPtr) != TCL_OK) {
	    Tcl_DecrRefCount(autoPathPtr);
	    return TCL_ERROR;
	}
	objPtr = TclPathPart(interp, objPtr, TCL_PATH_DIRNAME);
	if (objPtr) {
	    result = TclListObjAppendIfAbsent(interp, autoPathPtr, objPtr);
	    Tcl_DecrRefCount(objPtr); /* TclPathPart returns a reference */
	    if (result != TCL_OK) {
		Tcl_DecrRefCount(autoPathPtr);
		return TCL_ERROR;
	    }
	}
    }

    /* parent/lib */
    Tcl_Obj *dirs[3] = {NULL, NULL, NULL}; /* exedir, exedirparent, lib */
    Tcl_Size dirCount = TclGetObjExecutableAncestors(interp, 2, dirs);
    if (dirCount == 2) {
	assert(dirs[1]);
	dirs[2] = Tcl_NewStringObj("lib", 3);
	Tcl_IncrRefCount(dirs[2]);
	objPtr = TclJoinPath(2, &dirs[1], 0);
	if (objPtr != NULL) {
            /* Note: TclListObjAppendIfAbsent handles 0 and non-0 ref counts */
	    (void) TclListObjAppendIfAbsent(NULL, autoPathPtr, objPtr);
	}
    }
    for (size_t i = 0; i < sizeof(dirs) / sizeof(dirs[0]); ++i) {
	if (dirs[i] != NULL) {
	    Tcl_DecrRefCount(dirs[i]);
	}
    }

    /* tcl_pkgPath. Errors ignored like original. Note no tildeexpand */
    (void) AddPathsInVarToList(interp, "tcl_pkgPath", NULL, autoPathPtr, 0);
    autoPathPtr =
	Tcl_SetVar2Ex(interp, "auto_path", NULL, autoPathPtr, TCL_GLOBAL_ONLY);
    if (autoPathPtr) {
	Tcl_SetObjResult(interp, autoPathPtr);
	return TCL_OK;
    } else {
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Init --
 *
 *	This function is typically invoked by Tcl_AppInit functions to find
 *	and source the "init.tcl" script, which should exist somewhere on the
396
397
398
399
400
401
402



403
404
405
406
407
408
409
     * The first directory on this path that contains a valid init.tcl script
     * will be set as the value of tcl_library.
     *
     * Note that this entire search mechanism can be bypassed by defining an
     * alternate tclInit command before calling Tcl_Init().
     */




    result = Tcl_EvalEx(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
"  proc tclInit {} {\n"
"    global tcl_libPath tcl_library env tclDefaultLibrary\n"
"    rename tclInit {}\n"
"    if {[info exists tcl_library]} {\n"
"	set scripts {{set tcl_library}}\n"







>
>
>







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
     * The first directory on this path that contains a valid init.tcl script
     * will be set as the value of tcl_library.
     *
     * Note that this entire search mechanism can be bypassed by defining an
     * alternate tclInit command before calling Tcl_Init().
     */

#if 1
    result = RunPreInitScript(interp);
#else
    result = Tcl_EvalEx(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
"  proc tclInit {} {\n"
"    global tcl_libPath tcl_library env tclDefaultLibrary\n"
"    rename tclInit {}\n"
"    if {[info exists tcl_library]} {\n"
"	set scripts {{set tcl_library}}\n"
461
462
463
464
465
466
467

468
469
470
471
472
473
474
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", TCL_INDEX_NONE, 0);

    TclpSetInitialEncodings();
end:
    *names = (*names)->nextPtr;
    return result;
}

/*







>







892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", TCL_INDEX_NONE, 0);
#endif
    TclpSetInitialEncodings();
end:
    *names = (*names)->nextPtr;
    return result;
}

/*
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
    childPtr->childEntryPtr	= NULL;
    childPtr->childInterp	= interp;
    childPtr->interpCmd		= NULL;
    Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);

    Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
	    NULL, NULL);


    Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *







|
>







942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
    childPtr->childEntryPtr	= NULL;
    childPtr->childInterp	= interp;
    childPtr->interpCmd		= NULL;
    Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);

    Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, INIT_AUTO_PATH_CMD, InitAutoPathObjCmd,
	    NULL, NULL);
    Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
Changes to generic/tclPathObj.c.
2723
2724
2725
2726
2727
2728
2729





































































2730
2731
2732
2733
2734
2735
2736
	    Tcl_ListObjAppendElement(NULL, resolvedPaths, resolvedPath);
	}
    }

    return resolvedPaths;
}






































































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







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
	    Tcl_ListObjAppendElement(NULL, resolvedPaths, resolvedPath);
	}
    }

    return resolvedPaths;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSGetAncestorPaths --
 *
 *	This function retrieves the paths to the directory ancestor(s) of
 *	the given path. The first element of the returned pathPtrs array is
 *	the directory of the passed path, the second is the parent of that
 *	directory and so on. If the number of elements requested is greater
 *	that the depth of the directory depth, the additional elements will
 *	contain NULL.
 *
 *	IMPORTANT: The objects returned in pathPtrs[] will have had their
 *	reference counts incremented so caller owns them.
 *
 * Results:
 *	Returns the number of elements filled with paths. On error, returns
 *	-1 with an error message in interp if not NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
TclFSGetAncestorPaths(
    Tcl_Interp *interp,		/* interp for errors. May be NULL */
    Tcl_Obj *pathPtr,		/* Path whose ancestor dirs are sought */
    Tcl_Size numPaths,		/* Size of pathPtrs[] */
    Tcl_Obj *pathsPtr[]	/* Output array holding ancestor paths */
)
{
    Tcl_Obj **components;
    Tcl_Size numComponents;
    Tcl_Obj *splitPathPtr = Tcl_FSSplitPath(pathPtr, NULL);
    if (splitPathPtr == NULL) {
	return -1;
    }
    Tcl_IncrRefCount(splitPathPtr);
    if (Tcl_ListObjGetElements(interp, splitPathPtr,
	    &numComponents, &components) != TCL_OK) {
	Tcl_DecrRefCount(splitPathPtr);
	return -1;
    }

    /*
     * /a/b/c ->
     * [0] = /a/b
     * [1] = /a
     * [2] = /
     * Remaining NULL.
     * Note numComponents may be 0 (empty string) or 1 (single path part)
     */

    Tcl_Size i, count;
    for (i = 0; i < numPaths && i < (numComponents-1); ++i) {
	pathsPtr[i] = TclJoinPath(numComponents - i - 1, components, 0);
	assert(pathsPtr[i]); /* Not supposed to ever fail */
	Tcl_IncrRefCount(pathsPtr[i]); /* Caller now owns */
    }
    count = i;
    /* Fill remaining with NULL */
    while (i < numPaths) {
	pathsPtr[i] = NULL;
    }
    Tcl_DecrRefCount(splitPathPtr);
    return count;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclUtil.c.
4350
4351
4352
4353
4354
4355
4356











































4357
4358
4359
4360
4361
4362
4363

Tcl_Obj *
TclGetObjNameOfExecutable(void)
{
    return TclGetProcessGlobalValue(&executableName);
}












































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetNameOfExecutable --
 *
 *	This function retrieves the absolute pathname of the application in
 *	which the Tcl library is running, and returns it in string form.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406

Tcl_Obj *
TclGetObjNameOfExecutable(void)
{
    return TclGetProcessGlobalValue(&executableName);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetObjExecutableAncestors --
 *
 *	This function retrieves the paths to the directory ancestor(s) of
 *	the application. The first element of the returned pathPtrs array is
 *	the directory of the application, the second is the parent of that
 *	directory and so on. If the number of elements requested is greater
 *	that the directory depth, the additional elements will contain NULL.
 *
 *	IMPORTANT: The objects returned in pathPtrs[] will have had their
 *	reference counts incremented so caller owns them.
 *
 * Results:
 *	Returns the number of elements filled with paths. On error, returns
 *	-1 with an error message in interp if not NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclGetObjExecutableAncestors(
    Tcl_Interp *interp,		/* interp for errors. May be NULL */
    Tcl_Size numPaths,		/* Size of pathPtrs[] */
    Tcl_Obj *pathsPtr[]	/* Output array holding ancestor paths */
)
{
    Tcl_Obj *exePtr = TclGetObjNameOfExecutable();
    if (exePtr == NULL) {
	if (interp) {
	    Tcl_SetResult(interp, "Could not retrieve path of executable.",
		TCL_STATIC);
	}
	return TCL_ERROR;
    }

    return TclFSGetAncestorPaths(interp, exePtr, numPaths, pathsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetNameOfExecutable --
 *
 *	This function retrieves the absolute pathname of the application in
 *	which the Tcl library is running, and returns it in string form.
Changes to library/init.tcl.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#	On UNIX it is compiled in
#       On Windows, it is not used
#
# (Ticket 41c9857bdd) In a safe interpreter, this file does not set
# ::auto_path (other than to {} if it is undefined). The caller, typically
# a Safe Base command, is responsible for setting ::auto_path.

if {![info exists auto_path]} {
    if {[info exists env(TCLLIBPATH)] && (![interp issafe])} {
	set auto_path [apply {{} {
	    lmap path $::env(TCLLIBPATH) {
		# Paths relative to unresolvable home dirs are ignored
		if {[catch {file tildeexpand $path} expanded_path]} {
		    continue
		}
		set expanded_path
	    }
	}}]
    } else {
	set auto_path ""
    }
}

namespace eval tcl {
    if {![interp issafe]} {
	variable Dir
	foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
	    if {$Dir ni $::auto_path} {
		lappend ::auto_path $Dir
	    }
	}
	set Dir [file join [file dirname [file dirname \
		[info nameofexecutable]]] lib]
	if {$Dir ni $::auto_path} {
	    lappend ::auto_path $Dir
	}
	if {[info exists ::tcl_pkgPath]} { catch {
	    foreach Dir $::tcl_pkgPath {
		if {$Dir ni $::auto_path} {
		    lappend ::auto_path $Dir
		}
	    }
	}}

	variable Path [encoding dirs]
	set Dir [file join $::tcl_library encoding]
	if {$Dir ni $Path} {
	    lappend Path $Dir
	    encoding dirs $Path
	}
	unset Dir Path
    }
}

namespace eval tcl::Pkg {}


# Setup the unknown package handler









<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







37
38
39
40
41
42
43















44






























45
46
47
48
49
50
51
#	On UNIX it is compiled in
#       On Windows, it is not used
#
# (Ticket 41c9857bdd) In a safe interpreter, this file does not set
# ::auto_path (other than to {} if it is undefined). The caller, typically
# a Safe Base command, is responsible for setting ::auto_path.
















tcl::InitAutoPath































namespace eval tcl::Pkg {}


# Setup the unknown package handler


Changes to unix/tclAppInit.c.
33
34
35
36
37
38
39











40
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63


































64
65
66
67
68
69
70
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_LibraryInitProc Tclxttest_Init;
#endif /* TCL_XT_TEST */












/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
 */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
MODULE_SCOPE int main(int, char **);

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv);
#endif



































/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.







>
>
>
>
>
>
>
>
>
>
>









>















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_LibraryInitProc Tclxttest_Init;
#endif /* TCL_XT_TEST */

/*
 * The following allows changing of the script file read at startup.
 */
#ifndef TCL_RC_FILE
#ifdef DJGPP
#define TCL_RC_FILE "~/tclshrc.tcl"
#else
#define TCL_RC_FILE "~/.tclshrc"
#endif
#endif

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
 */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
MODULE_SCOPE int main(int, char **);

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv);
#endif

/*
 * TclSetRcFilePath --
 *
 *	Sets the path of the Tcl startup file (usually ".tclshrc"). Will
 *	do tilde expansion and normalization of the passed path and set
 *	the tclRcFilePath variable to the result
 *
 * Results:
 *	A Tcl result code.
 *
 * Side effects:
 *	Sets the tclRcFilePath variable.
 *
 * TODO - this function is duplicated in the Windows version of tclAppInit.c.
 * Consider adding it to Tcl library and callable via the stubs table.
 */
static int
TclSetRcFilePath(Tcl_Interp *interp, const char *path)
{
    Tcl_DString ds;
    if (Tcl_FSTildeExpand(interp, path, &ds) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Obj *rcPathObj = Tcl_DStringToObj(&ds);
    /* Reminder: don't worry about rcPathObj ref count on success/failure */
    if (Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, rcPathObj,
	    TCL_GLOBAL_ONLY) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;

}


/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
157
158
159
160
161
162
163


164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.


     */
#ifdef DJGPP
#define INITFILENAME "tclshrc.tcl"
#else
#define INITFILENAME ".tclshrc"
#endif

    (void) Tcl_EvalEx(interp,
	    "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]",
	    -1, TCL_EVAL_GLOBAL);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







>
>

<
<
<
<
<
|
|
<
<


|







203
204
205
206
207
208
209
210
211
212





213
214


215
216
217
218
219
220
221
222
223
224
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     * In keeping with the historical behavior, errors setting the name
     * for example, if the home directory cannot be found, are ignored.
     */





    (void) TclSetRcFilePath(interp, TCL_RC_FILE);
    Tcl_ResetResult(interp);


    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclAppInit.c.
62
63
64
65
66
67
68







69
70
71
72
73
74
75
76
77


































78
79
80
81
82
83
84
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);








/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
#endif



































/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.







>
>
>
>
>
>
>









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);

/*
 * The following allows changing of the script file read at startup.
 */
#ifndef TCL_RC_FILE
#define TCL_RC_FILE "~/tclshrc.tcl"
#endif

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
#endif

/*
 * TclSetRcFilePath --
 *
 *	Sets the path of the Tcl startup file (usually ".tclshrc"). Will
 *	do tilde expansion and normalization of the passed path and set
 *	the tclRcFilePath variable to the result
 *
 * Results:
 *	A Tcl result code.
 *
 * Side effects:
 *	Sets the tclRcFilePath variable.
 *
 * TODO - this function is duplicated in the Unix version of tclAppInit.c.
 * Consider adding it to Tcl library and callable via the stubs table.
 */
static int
TclSetRcFilePath(Tcl_Interp *interp, const char *path)
{
    Tcl_DString ds;
    if (Tcl_FSTildeExpand(interp, path, &ds) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Obj *rcPathObj = Tcl_DStringToObj(&ds);
    /* Reminder: don't worry about rcPathObj ref count on success/failure */
    if (Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, rcPathObj,
	    TCL_GLOBAL_ONLY) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;

}


/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
192
193
194
195
196
197
198


199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.


     */

    (void)Tcl_EvalEx(interp,
	    "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]",
	    TCL_AUTO_LENGTH, TCL_EVAL_GLOBAL);

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







>
>

|
<
<
<
|


|







233
234
235
236
237
238
239
240
241
242
243



244
245
246
247
248
249
250
251
252
253
254
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     * In keeping with the historical behavior, errors setting the name
     * for example, if the home directory cannot be found, are ignored.
     */
    (void) TclSetRcFilePath(interp, TCL_RC_FILE);



    Tcl_ResetResult(interp);
    return TCL_OK;
}

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