Diff
Not logged in

Differences From Artifact [117fdb3fce]:

To Artifact [a46b88cb13]:


454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468







-
+







void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    Tcl_Obj *pathPtr;
    const char *str;
    Tcl_DString buffer;

    TclNewObj(pathPtr);

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
491
492
493
494
495
496
497
498

499
500
501
502
503
504
505
491
492
493
494
495
496
497

498
499
500
501
502
503
504
505







-
+








	snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */

	Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(NULL, pathPtr, TclNewString(str));

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
532
533
534
535
536
537
538
539
540

541
542
543
544
545
546
547
532
533
534
535
536
537
538


539
540
541
542
543
544
545
546







-
-
+







	    /*
	     * TODO: Pull this value from the TIP 59 table.
	     */

	    str = defaultLibraryDir;
	}
	if (str[0] != '\0') {
	    objPtr = Tcl_NewStringObj(str, TCL_INDEX_NONE);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclNewString(str));
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);

    /*
637
638
639
640
641
642
643
644

645
646
647
648

649
650

651
652
653
654
655
656
657
636
637
638
639
640
641
642

643
644
645
646

647
648

649
650
651
652
653
654
655
656







-
+



-
+

-
+







	Tcl_DString ds;

	/*
	 * Use a DString so we can modify case.
	 */

	Tcl_DStringInit(&ds);
	encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), TCL_INDEX_NONE);
	encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), TCL_AUTO_LENGTH);
	Tcl_UtfToLower(Tcl_DStringValue(&ds));
	knownEncoding = SearchKnownEncodings(encoding);
	if (knownEncoding != NULL) {
	    Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
	    Tcl_DStringAppend(bufPtr, knownEncoding, TCL_AUTO_LENGTH);
	} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
	    Tcl_DStringAppend(bufPtr, encoding, TCL_INDEX_NONE);
	    Tcl_DStringAppend(bufPtr, encoding, TCL_AUTO_LENGTH);
	}
	Tcl_DStringFree(&ds);
	if (Tcl_DStringLength(bufPtr)) {
	    return Tcl_DStringValue(bufPtr);
	}
    }
#endif /* HAVE_LANGINFO */
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
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







-
+




-
+

-
+




















-
+

-
+







-
+








    if (encoding != NULL) {
	const char *p;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	p = encoding;
	encoding = Tcl_DStringAppend(&ds, p, TCL_INDEX_NONE);
	encoding = Tcl_DStringAppend(&ds, p, TCL_AUTO_LENGTH);
	Tcl_UtfToLower(Tcl_DStringValue(&ds));

	knownEncoding = SearchKnownEncodings(encoding);
	if (knownEncoding != NULL) {
	    Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
	    Tcl_DStringAppend(bufPtr, knownEncoding, TCL_AUTO_LENGTH);
	} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
	    Tcl_DStringAppend(bufPtr, encoding, TCL_INDEX_NONE);
	    Tcl_DStringAppend(bufPtr, encoding, TCL_AUTO_LENGTH);
	}
	if (Tcl_DStringLength(bufPtr)) {
	    Tcl_DStringFree(&ds);
	    return Tcl_DStringValue(bufPtr);
	}

	/*
	 * We didn't recognize the full value as an encoding name. If there is
	 * an encoding subfield, we can try to guess from that.
	 */

	for (p = encoding; *p != '\0'; p++) {
	    if (*p == '.') {
		p++;
		break;
	    }
	}
	if (*p != '\0') {
	    knownEncoding = SearchKnownEncodings(p);
	    if (knownEncoding != NULL) {
		Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
		Tcl_DStringAppend(bufPtr, knownEncoding, TCL_AUTO_LENGTH);
	    } else if (NULL != Tcl_GetEncoding(NULL, p)) {
		Tcl_DStringAppend(bufPtr, p, TCL_INDEX_NONE);
		Tcl_DStringAppend(bufPtr, p, TCL_AUTO_LENGTH);
	    }
	}
	Tcl_DStringFree(&ds);
	if (Tcl_DStringLength(bufPtr)) {
	    return Tcl_DStringValue(bufPtr);
	}
    }
    return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, TCL_INDEX_NONE);
    return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, TCL_AUTO_LENGTH);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
820
821

822
823
824
825
826
827
828
829
830
831
832
833
834
835
836

837
838
839
840
841
842
843
844
845
846

847
848
849
850
851
852
853
854
855
856
857
858
859

860
861

862
863
864
865
866
867
868
804
805
806
807
808
809
810

811
812
813
814
815
816
817
818
819

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834

835
836
837
838
839
840
841
842
843
844

845
846
847
848
849
850
851
852
853
854
855
856
857

858
859

860
861
862
863
864
865
866
867







-
+








-
+














-
+









-
+












-
+

-
+








    if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
	const char *str;
	CFBundleRef bundleRef;
	Tcl_DString ds;

	Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
	Tcl_ListObjAppendElement(NULL, pkgListObj, TclNewString(tclLibPath));
	str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
	if ((str != NULL) && (str[0] != '\0')) {
	    p = Tcl_DStringValue(&ds);
	    while ((q = strchr(p, ':')) != NULL) {
		Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
		p = q+1;
	    }
	    if (*p) {
		Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
		Tcl_ListObjAppendElement(NULL, pkgListObj, TclNewString(p));
	    }
	    Tcl_DStringFree(&ds);
	}
	bundleRef = CFBundleGetMainBundle();
	if (bundleRef) {
	    CFURLRef frameworksURL;
	    Tcl_StatBuf statBuf;

	    frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef);
	    if (frameworksURL) {
		if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
			(unsigned char*) tclLibPath, MAXPATHLEN) &&
			! TclOSstat(tclLibPath, &statBuf) &&
			S_ISDIR(statBuf.st_mode)) {
		    Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
		    Tcl_ListObjAppendElement(NULL, pkgListObj, TclNewString(tclLibPath));
		}
		CFRelease(frameworksURL);
	    }
	    frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef);
	    if (frameworksURL) {
		if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
			(unsigned char*) tclLibPath, MAXPATHLEN) &&
			! TclOSstat(tclLibPath, &statBuf) &&
			S_ISDIR(statBuf.st_mode)) {
		    Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
		    Tcl_ListObjAppendElement(NULL, pkgListObj, TclNewString(tclLibPath));
		}
		CFRelease(frameworksURL);
	    }
	}
    }
#endif /* HAVE_COREFOUNDATION */
    p = pkgPath;
    while ((q = strchr(p, ':')) != NULL) {
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
	p = q+1;
    }
    if (*p) {
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
	Tcl_ListObjAppendElement(NULL, pkgListObj, TclNewString(p));
    }
    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY);
    Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pkgListObj, TCL_GLOBAL_ONLY);
    {
        /* Some platforms build configure scripts expect ~ expansion so do that */
        Tcl_Obj *origPaths;
        Tcl_Obj *resolvedPaths;

        origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY);
        resolvedPaths = TclResolveTildePathList(origPaths);