home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / tclOS2Reg.c < prev    next >
C/C++ Source or Header  |  2001-02-09  |  38KB  |  1,258 lines
  1. /* 
  2.  * tclOS2Reg.c --
  3.  *
  4.  *    This file contains the implementation of the "registry" Tcl
  5.  *    built-in command.  This command is built as a dynamically
  6.  *    loadable extension in a separate DLL.
  7.  *
  8.  * Copyright (c) 1997 by Sun Microsystems, Inc.
  9.  * Copyright (c) 1999-2001 Illya Vaes
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tclOS2Reg.c 1.8 97/08/01 11:17:49
  15.  */
  16.  
  17. #include "tclOS2Int.h"
  18.  
  19. /*
  20.  * The following tables contain the mapping from registry root names
  21.  * to the system predefined keys.
  22.  */
  23.  
  24. static char *iniFileNames[] = {
  25.     "BOTH", "USER", "SYSTEM", NULL
  26. };
  27.  
  28. static HINI iniHandles[] = {
  29.     HINI_PROFILE, HINI_USERPROFILE, HINI_SYSTEMPROFILE, NULLHANDLE
  30. };
  31.  
  32. /*
  33.  * The following define the amount of apps/keys we can enumerate from
  34.  * a profile.
  35.  */
  36. #define MAX_APPS    512        /* per profile */
  37. #define MAX_APPLEN    32
  38. #define MAX_KEYS    128        /* per app per profile */
  39. /* If we want a high ENUM_KEYS, don't use 'char list[ENUM_KEYS]' but 'malloc' */
  40. #define MAX_KEYLEN    64 /* CCHMAXPATH */
  41. #define ENUM_APPS    (MAX_APPS * MAX_APPLEN)
  42. #define ENUM_KEYS    (MAX_KEYS * MAX_KEYLEN)
  43.  
  44. #define USERPROFILE    0
  45. #define SYSTEMPROFILE    1
  46.  
  47. /* Array for paths of profiles at time of loading. */
  48. static char userIniPath[CCHMAXPATH+1];
  49. static char sysIniPath[CCHMAXPATH+1];
  50.  
  51. /*
  52.  * The following gives the possible types to write keys as and mappings from
  53.  * the possible type argument to the registry command.
  54.  */
  55.  
  56. #define BINARY    0
  57. #define LONG    1
  58. #define STRING    2
  59. #define SZ    3
  60. #define    DWORD    4
  61. #define MAXTYPE    DWORD
  62.  
  63. static char *typeNames[] = {
  64.     "binary", "long", "string",
  65.     "sz", "dword",  /* for Windows compatibility */
  66.     NULL
  67. };
  68.  
  69. static ULONG ret;
  70.  
  71.  
  72. /*
  73.  * Declarations for functions defined in this file.
  74.  */
  75.  
  76. static void        AppendSystemError(Tcl_Interp *interp, ULONG error);
  77. static int        RegistryObjCmd(ClientData clientData,
  78.                         Tcl_Interp *interp, int objc,
  79.                             Tcl_Obj * CONST objv[]);
  80.  
  81. /* Windows compatible functions */
  82. static int        TclOS2RegDelete(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
  83.                 Tcl_Obj *valueNameObj);
  84. static int        TclOS2GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
  85.                 Tcl_Obj *valueNameObj, Tcl_Obj *typeObj);
  86. static int        TclOS2GetKeyNames(Tcl_Interp *interp,
  87.                 Tcl_Obj *keyNameObj, Tcl_Obj *patternObj);
  88. static int        TclOS2SetKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
  89.                 Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
  90.                 Tcl_Obj *typeObj);
  91.  
  92. /* Utility functions */
  93. static int        TclOS2OpenProfile(Tcl_Interp *interp, char *name,
  94.                         char **iniFilePtr, char **keyNamePtr,
  95.                         HINI *iniHandlePtr);
  96. static int        TclOS2CloseProfile(HINI iniHandle);
  97.  
  98. /* OS/2 specific functionality */
  99. static int              TclOS2GetAppNames(Tcl_Interp *interp,
  100.                             Tcl_Obj *iniFileObj, Tcl_Obj *patternObj);
  101. static int              TclOS2GetAppKeyNames(Tcl_Interp *interp,
  102.                             Tcl_Obj *appNameObj, Tcl_Obj *patternObj);
  103. static int              TclOS2SetAppKey(Tcl_Interp *interp, Tcl_Obj *appNameObj,
  104.                             Tcl_Obj *keyNameObj, Tcl_Obj *dataObj,
  105.                             Tcl_Obj *typeObj);
  106.  
  107. int    Registry_Init(Tcl_Interp *interp);
  108.  
  109. /*
  110.  *----------------------------------------------------------------------
  111.  *
  112.  * _DLL_InitTerm --
  113.  *
  114.  *    This wrapper function is used by OS/2 to invoke the
  115.  *    initialization code for the DLL.
  116.  *
  117.  * Results:
  118.  *    Returns TRUE on success, FALSE on failure;
  119.  *
  120.  * Side effects:
  121.  *    None.
  122.  *
  123.  *----------------------------------------------------------------------
  124.  */
  125.  
  126. #ifdef __OS2__
  127. #ifndef STATIC_BUILD
  128. unsigned long
  129. _DLL_InitTerm(
  130.     unsigned long hInst,    /* Library instance handle. */
  131.     unsigned long reason)    /* Reason this function is being called. */
  132. {
  133.     switch (reason) {
  134.     case 0: {    /* INIT */
  135.         /*
  136.          * Store paths of profiles into their array.
  137.          * Since the info isn't used (yet), we won't consider failure a
  138.          * fatal error.
  139.          */
  140.         
  141.         PRFPROFILE prfProfile;
  142.         /* Fill in the lengths with 0 or PrfQueryProfile will fail! */
  143.         prfProfile.pszUserName = userIniPath;
  144.         prfProfile.cchUserName = sizeof(userIniPath);
  145.         userIniPath[prfProfile.cchUserName-1] = '\0';
  146.         prfProfile.pszSysName = sysIniPath;
  147.         prfProfile.cchSysName = sizeof(sysIniPath);
  148.         sysIniPath[prfProfile.cchSysName-1] = '\0';
  149.  
  150. #ifdef VERBOSE
  151.         printf("TclOS2GetHAB(): %x\n", TclOS2GetHAB());
  152. #endif
  153.         if (PrfQueryProfile(TclOS2GetHAB(), &prfProfile) == TRUE) {
  154. #ifdef VERBOSE
  155.             printf("User Profile [%s] (%d)\nSystem Profile [%s] (%d)\n",
  156.                    prfProfile.pszUserName, prfProfile.cchUserName,
  157.                    prfProfile.pszSysName, prfProfile.cchSysName);
  158. #endif
  159.         } else {
  160. #ifdef VERBOSE
  161.             printf("PrfQueryProfile ERROR %x\n",
  162.                    WinGetLastError(TclOS2GetHAB()));
  163. #endif
  164.             userIniPath[0] = '\0';
  165.             sysIniPath[0] = '\0';
  166.         }
  167.         return TRUE;
  168.  
  169.         break;
  170.     }
  171.  
  172.     case 1:     /* TERM */
  173. #ifdef VERBOSE
  174.         printf("_DLL_InitTerm TERM\n");
  175.         fflush(stdout);
  176. #endif
  177.         return TRUE;
  178.     }
  179.  
  180.     return FALSE;
  181. }
  182. #endif
  183. #endif
  184.  
  185. /*
  186.  *----------------------------------------------------------------------
  187.  *
  188.  * Registry_Init --
  189.  *
  190.  *    This procedure initializes the registry command.
  191.  *
  192.  * Results:
  193.  *    A standard Tcl result.
  194.  *
  195.  * Side effects:
  196.  *    None.
  197.  *
  198.  *----------------------------------------------------------------------
  199.  */
  200.  
  201. int
  202. Registry_Init(
  203.     Tcl_Interp *interp)
  204. {
  205. #ifdef VERBOSE
  206.     printf("Registry_Init\n");
  207.     fflush(stdout);
  208. #endif
  209.     Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
  210. /*
  211.     Tcl_CreateObjCommand(interp, "profile", RegistryObjCmd, NULL, NULL);
  212.     Tcl_CreateObjCommand(interp, "ini", RegistryObjCmd, NULL, NULL);
  213. */
  214.     return Tcl_PkgProvide(interp, "registry", "1.0");
  215. }
  216.  
  217. /*
  218.  *----------------------------------------------------------------------
  219.  *
  220.  * RegistryObjCmd --
  221.  *
  222.  *    This function implements the Tcl "registry" command, also known
  223.  *    as "profile" and "ini" in the OS/2 version.
  224.  *
  225.  * Results:
  226.  *    A standard Tcl result.
  227.  *
  228.  * Side effects:
  229.  *    None.
  230.  *
  231.  *----------------------------------------------------------------------
  232.  */
  233.  
  234. static int
  235. RegistryObjCmd(
  236.     ClientData clientData,    /* Not used. */
  237.     Tcl_Interp *interp,        /* Current interpreter. */
  238.     int objc,            /* Number of arguments. */
  239.     Tcl_Obj * CONST objv[])    /* Argument values. */
  240. {
  241.     int index;
  242.     char *errString = NULL;
  243.  
  244.     static char *subcommands[] = { "delete", "get", "keys", "set", "type",
  245.                                    "values",
  246.                                    "apps", "appkeys", "appset",
  247.                                    (char *) NULL };
  248.     enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx,
  249.                      AppsIdx, AppKeysIdx, AppSetIdx };
  250. #ifdef VERBOSE
  251.     printf("RegistryObjCmd()\n");
  252.     fflush(stdout);
  253. #endif
  254.  
  255.     if (objc < 2) {
  256.         Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
  257.         return TCL_ERROR;
  258.     }
  259.  
  260.     if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
  261.             != TCL_OK) {
  262.         return TCL_ERROR;
  263.     }
  264.  
  265.     switch (index) {
  266.         case DeleteIdx:            /* delete */
  267.             if (objc == 3) {
  268.                 return TclOS2RegDelete(interp, objv[2], NULL);
  269.             } else if (objc == 4) {
  270.                 return TclOS2RegDelete(interp, objv[2], objv[3]);
  271.             }
  272.             errString = "keyName ?valueName?";
  273.             break;
  274.         case GetIdx:            /* get */
  275.             if (objc == 4) {
  276.                 return TclOS2GetValue(interp, objv[2], objv[3], NULL);
  277.             } else if (objc == 5) {
  278.                 return TclOS2GetValue(interp, objv[2], objv[3], objv[4]);
  279.             }
  280.             errString = "keyName valueName ?asType?";
  281.             break;
  282.         case KeysIdx:            /* keys */
  283.             if (objc == 3) {
  284.                 return TclOS2GetKeyNames(interp, objv[2], NULL);
  285.             } else if (objc == 4) {
  286.                 return TclOS2GetKeyNames(interp, objv[2], objv[3]);
  287.             }
  288.             errString = "keyName ?pattern?";
  289.             break;
  290.         case SetIdx:            /* set */
  291.             if (objc == 3) {
  292.                 /* Only the application isn't possible but will not complain */
  293.                 return TclOS2SetKey(interp, objv[2], NULL, NULL, NULL);
  294.             } else if (objc == 5 || objc == 6) {
  295.                 Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
  296.                 return TclOS2SetKey(interp, objv[2], objv[3], objv[4], typeObj);
  297.             }
  298.             errString = "keyName ?valueName data ?type??";
  299.             break;
  300.         case ValuesIdx:                 /* values */
  301.             if (objc == 3 || objc == 4) {
  302.                 return TclOS2GetValue(interp, objv[2], objv[3], NULL);
  303.             }
  304.             errString = "keyName ?pattern?";
  305.             break;
  306.         case AppsIdx:            /* apps */
  307.             if (objc == 3) {
  308.                 return TclOS2GetAppNames(interp, objv[2], NULL);
  309.             } else if (objc == 4) {
  310.                 return TclOS2GetAppNames(interp, objv[2], objv[3]);
  311.             }
  312.             errString = "iniFile ?pattern?";
  313.             break;
  314.         case AppKeysIdx:        /* appkeys */
  315.             if (objc == 3) {
  316.                 return TclOS2GetAppKeyNames(interp, objv[2], NULL);
  317.             } else if (objc == 4) {
  318.                 return TclOS2GetAppKeyNames(interp, objv[2], objv[3]);
  319.             }
  320.             errString = "iniFile\\\\appName ?pattern?";
  321.             break;
  322.         case AppSetIdx:            /* appset */
  323.             if (objc == 3) {
  324.                 /* Only the application */
  325.                 return TclOS2SetAppKey(interp, objv[2], NULL, NULL, NULL);
  326.             } else if (objc == 5 || objc == 6) {
  327.                 Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
  328.                 return TclOS2SetAppKey(interp, objv[2], objv[3], objv[4],
  329.                                        typeObj);
  330.             }
  331.             errString = "appName ?keyName data ?type??";
  332.             break;
  333.     }
  334.     Tcl_WrongNumArgs(interp, 2, objv, errString);
  335.     return TCL_ERROR;
  336. }
  337.  
  338. /*
  339.  *----------------------------------------------------------------------
  340.  *
  341.  * TclOS2RegDelete --
  342.  *
  343.  *    This function deletes an application or key.
  344.  *
  345.  * Results:
  346.  *    A standard Tcl result.
  347.  *
  348.  * Side effects:
  349.  *    None.
  350.  *
  351.  *----------------------------------------------------------------------
  352.  */
  353.  
  354. static int
  355. TclOS2RegDelete(
  356.     Tcl_Interp *interp,        /* Current interpreter. */
  357.     Tcl_Obj *keyNameObj,    /* Name of app to delete. */
  358.     Tcl_Obj *valueNameObj)    /* Name of key to delete. */
  359. {
  360.     char *buffer, *iniFile, *keyName, *valueName;
  361.     HINI iniHandle;
  362.     int length;
  363.     Tcl_Obj *resultPtr;
  364.  
  365.     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
  366.     buffer = ckalloc(length + 1);
  367.     strcpy(buffer, keyName);
  368.     valueName = (valueNameObj != NULL)
  369.                               ? Tcl_GetStringFromObj(valueNameObj, &length)
  370.                               : NULL;
  371. #ifdef VERBOSE
  372.     printf("TclOS2RegDelete(%s, %s)\n", keyName, valueName);
  373.     fflush(stdout);
  374. #endif
  375.  
  376.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
  377.             != TCL_OK) {
  378.         ckfree(buffer);
  379.         return TCL_ERROR;
  380.     }
  381.     ckfree(buffer);
  382.  
  383.     resultPtr = Tcl_GetObjResult(interp);
  384.     if (valueName != NULL && *valueName == '\0') {
  385.         Tcl_AppendToObj(resultPtr, "bad key: cannot delete null keys", -1);
  386.         return TCL_ERROR;
  387.     }
  388.  
  389.     /* Deleting application is done by passing NULL pszKey value */
  390.     ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName, (PVOID)NULL,
  391.                               0);
  392. #ifdef VERBOSE
  393.     printf("PrfWriteProfileData(%x, %s, %s, NULL, 0) returns %d\n", iniHandle,
  394.            keyName, valueName, ret);
  395.     fflush(stdout);
  396. #endif
  397.     if (ret != TRUE) {
  398.         Tcl_AppendStringsToObj(resultPtr, "unable to delete key \"",
  399.             Tcl_GetStringFromObj(valueNameObj, NULL), "\" from application \"",
  400.             Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
  401.         AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
  402.         return TCL_ERROR;
  403.     }
  404.  
  405.     TclOS2CloseProfile(iniHandle);
  406.     return TCL_OK;
  407. }
  408.  
  409. /*
  410.  *----------------------------------------------------------------------
  411.  *
  412.  * TclOS2GetValue --
  413.  *
  414.  *    This function querys the profile for the value of a key.
  415.  *
  416.  * Results:
  417.  *    A standard Tcl result.
  418.  *    Returns the list of applications in the result object of the
  419.  *    interpreter, or an error message on failure.
  420.  *
  421.  * Side effects:
  422.  *    None.
  423.  *
  424.  *----------------------------------------------------------------------
  425.  */
  426.  
  427. static int
  428. TclOS2GetValue(
  429.     Tcl_Interp *interp,        /* Current interpreter. */
  430.     Tcl_Obj *keyNameObj,    /* Name of app. */
  431.     Tcl_Obj *valueNameObj,    /* Name of key to query. */
  432.     Tcl_Obj *typeObj)        /* Type of data to be written. */
  433. {
  434.     char *buffer, *iniFile, *keyName, *valueName;
  435.     HINI iniHandle;
  436.     int length;
  437.     ULONG maxBuf;
  438.     Tcl_Obj *resultPtr;
  439.     Tcl_DString data;
  440.  
  441. /* IMPLEMENTATION STILL IGNORES TYPE */
  442.     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
  443.     buffer = ckalloc(length + 1);
  444.     strcpy(buffer, keyName);
  445.     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
  446. #ifdef VERBOSE
  447.     printf("TclOS2RegGetValue(%s, %s)\n", keyName, valueName);
  448.     fflush(stdout);
  449. #endif
  450.  
  451.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
  452.             != TCL_OK) {
  453.         ckfree(buffer);
  454.         return TCL_ERROR;
  455.     }
  456.     ckfree(buffer);
  457.  
  458.     /*
  459.      * Initialize a Dstring to maximum statically allocated size
  460.      * we could get one more byte by avoiding Tcl_DStringSetLength()
  461.      * and just setting maxBuf to TCL_DSTRING_STATIC_SIZE, but this
  462.      * should be safer if the implementation Dstrings changes.
  463.      * There's no API call to query the length of the key value.
  464.      */
  465.  
  466.     Tcl_DStringInit(&data);
  467.     Tcl_DStringSetLength(&data, maxBuf = TCL_DSTRING_STATIC_SIZE - 1);
  468.  
  469.     resultPtr = Tcl_GetObjResult(interp);
  470.  
  471.     ret = PrfQueryProfileData(iniHandle, keyName, valueName,
  472.                              (PVOID) Tcl_DStringValue(&data), &maxBuf);
  473. #ifdef VERBOSE
  474.     printf("PrfQueryProfileData(%x, %s, %s, <>, %d) returns %d\n", iniHandle,
  475.            keyName, valueName, maxBuf, ret);
  476.     printf("   WinGetLastError %x, maxBuf now %d\n",
  477.            WinGetLastError(TclOS2GetHAB()), maxBuf);
  478.     fflush(stdout);
  479. #endif
  480.     TclOS2CloseProfile(iniHandle);
  481.     if (ret != TRUE) {
  482.         Tcl_AppendStringsToObj(resultPtr, "unable to get key \"",
  483.             Tcl_GetStringFromObj(valueNameObj, NULL), "\" from application \"",
  484.             Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
  485.         AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
  486.         Tcl_DStringFree(&data);
  487.         return TCL_ERROR;
  488.     }
  489.  
  490.     /*
  491.      * OS/2 Profile data has no inherent type, only how applications wish to
  492.      * view them. Therefore, store it as a binary string.
  493.      */
  494.  
  495.     Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), maxBuf);
  496.     Tcl_DStringFree(&data);
  497.     return (ret == TRUE) ? TCL_OK : TCL_ERROR;
  498. }
  499.  
  500. /*
  501.  *----------------------------------------------------------------------
  502.  *
  503.  * TclOS2GetKeyNames --
  504.  *
  505.  *    This function enumerates the keys of in a profile.
  506.  *    If the optional pattern is supplied, then only key
  507.  *    names that match the pattern will be returned.
  508.  *
  509.  * Results:
  510.  *    Returns the list of key names in the result object of the
  511.  *    interpreter, or an error message on failure.
  512.  *
  513.  * Side effects:
  514.  *    None.
  515.  *
  516.  *----------------------------------------------------------------------
  517.  */
  518.  
  519. static int
  520. TclOS2GetKeyNames(
  521.     Tcl_Interp *interp,        /* Current interpreter. */
  522.     Tcl_Obj *keyNameObj,    /* Key to enumerate. */
  523.     Tcl_Obj *patternObj)    /* Optional match pattern. */
  524. {
  525.     char *p, *buffer, *iniFile, *keyName;
  526.     char apps[ENUM_APPS];
  527.     char keyList[ENUM_KEYS];
  528.     char fullName[ENUM_APPS + MAX_KEYLEN];
  529.     ULONG bufMax;
  530.     HINI iniHandle;
  531.     int length, len2 = 0;
  532.     Tcl_Obj *resultPtr;
  533.     int result = TCL_OK;
  534.     char *pattern;
  535.  
  536.     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
  537. #ifdef VERBOSE
  538.     printf("TclOS2GetKeyNames, keyName [%s]\n", keyName);
  539.     fflush(stdout);
  540. #endif
  541.     buffer = ckalloc(length + 1);
  542.     strcpy(buffer, keyName);
  543.  
  544.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
  545.             != TCL_OK) {
  546.         ckfree(buffer);
  547.         return TCL_ERROR;
  548.     }
  549.     ckfree(buffer);
  550.  
  551.     /*
  552.      * If the keyName now is the empty string, that means we have to
  553.      * enumerate ALL the applications and their keys.
  554.      */
  555.  
  556.     if ( strcmp(keyName, "") == 0 ) {
  557.         bufMax = sizeof(apps);
  558.         if ( PrfQueryProfileData(iniHandle, NULL, NULL, &apps, &bufMax)
  559.              != TRUE) {
  560. #ifdef VERBOSE
  561.             printf("    PrfQueryProfileData ERROR %x\n",
  562.                    WinGetLastError(TclOS2GetHAB()));
  563.             fflush(stdout);
  564. #endif
  565.             TclOS2CloseProfile(iniHandle);
  566.             return TCL_ERROR;
  567.         }
  568.         /*
  569.          * apps now contains the names of the applications, separated by NULL
  570.          * characters; the last is terminated with two successive NULLs.
  571.          * bufMax now contains the total length of the list in apps excluding
  572.          * the final NULL character.
  573.          */
  574. #ifdef VERBOSE
  575.         printf("    PrfQueryProfileData returns %d in apps (first %s)\n",
  576.                bufMax, apps);
  577.         fflush(stdout);
  578. #endif
  579.  
  580.     } else {
  581.         /* Put single appname with second NULL character behind it in apps */
  582.         strcpy(apps, keyName);
  583.         p = apps + strlen(keyName) + 1;
  584.         *p = '\0';
  585.     }
  586.  
  587.     /* for keyName in list of applications */
  588.     for (keyName = apps; *keyName != '\0'; keyName += strlen(keyName)+1) {
  589.         /* query keys for this application */
  590. #ifdef VERBOSE
  591.         printf("    Querying keys of application [%s]\n", keyName);
  592.         fflush(stdout);
  593. #endif
  594.         bufMax = sizeof(keyList);
  595.         if ( PrfQueryProfileData(iniHandle, keyName, NULL, &keyList, &bufMax)
  596.              != TRUE) {
  597. #ifdef VERBOSE
  598.             printf("PrfQueryProfileData(%x, %s, NULL, keyList, %d) ERROR %x\n",
  599.                    iniHandle, keyName, bufMax, WinGetLastError(TclOS2GetHAB()));
  600.             fflush(stdout);
  601. #endif
  602.             TclOS2CloseProfile(iniHandle);
  603.             return TCL_ERROR;
  604.         }
  605.         /*
  606.          * keyList now contains the names of the keys, separated by NULL
  607.          * characters; the last is terminated with two successive NULLs.
  608.          * bufMax now contains the total length of the list in keyList
  609.          * excluding the final NULL character.
  610.          */
  611. #ifdef VERBOSE
  612.         printf("    PrfQueryProfileData returns %d in buffer (first %s)\n",
  613.                bufMax, keyList);
  614.         fflush(stdout);
  615. #endif
  616.  
  617.         if (patternObj) {
  618.             pattern = Tcl_GetStringFromObj(patternObj, NULL);
  619.         } else {
  620.             pattern = NULL;
  621.         }
  622.  
  623.         /*
  624.          * Enumerate over the keys until we get to the double NULL, indicating
  625.          * the end of the list.
  626.          */
  627.  
  628.         resultPtr = Tcl_GetObjResult(interp);
  629.         for (p = keyList; *p != '\0'; p += len2+1) {
  630.             length = strlen(keyName);
  631.             len2 = strlen(p);
  632. #ifdef VERBOSE
  633.             printf("    keyName [%s] len %d, p [%s] len %d\n", keyName, length,
  634.                    p, len2);
  635.             fflush(stdout);
  636. #endif
  637.             if (length + 1 + len2 >= ENUM_APPS + MAX_KEYLEN) continue;
  638.             fullName[0] = '\0';
  639.             strcpy(fullName, keyName);
  640.             strcat(fullName, "\\");
  641.             strcat(fullName, p);
  642.             if (pattern && !Tcl_StringMatch(fullName, pattern)) {
  643. #ifdef VERBOSE
  644.                 printf("    Dismissing %s\n", fullName);
  645.                 fflush(stdout);
  646. #endif
  647.                 continue;
  648.             }
  649. #ifdef VERBOSE
  650.             printf("    Adding %s\n", fullName);
  651.             fflush(stdout);
  652. #endif
  653.             result = Tcl_ListObjAppendElement(interp, resultPtr,
  654.                     Tcl_NewStringObj(fullName, -1));
  655.             if (result != TCL_OK) {
  656.                 break;
  657.             }
  658.         }
  659.     }
  660.  
  661.     TclOS2CloseProfile(iniHandle);
  662.     return result;
  663. }
  664.  
  665. /*
  666.  *----------------------------------------------------------------------
  667.  *
  668.  * TclOS2SetKey --
  669.  *
  670.  *    This function sets the contents of a profile value.  If
  671.  *    the application or key does not exist, it will be created.  If it
  672.  *    does exist, then the data will be replaced.
  673.  *    Only writing as binary data and string is possible.
  674.  *
  675.  * Results:
  676.  *    Returns a normal Tcl result.
  677.  *
  678.  * Side effects:
  679.  *    May create new apps or keys.
  680.  *
  681.  *----------------------------------------------------------------------
  682.  */
  683.  
  684. static int
  685. TclOS2SetKey(
  686.     Tcl_Interp *interp,        /* Current interpreter. */
  687.     Tcl_Obj *keyNameObj,    /* Name of application. */
  688.     Tcl_Obj *valueNameObj,    /* Name of value to set. */
  689.     Tcl_Obj *dataObj,        /* Data to be written. */
  690.     Tcl_Obj *typeObj)        /* Type of data to be written. */
  691. {
  692.     char *buffer, *iniFile, *keyName, *valueName;
  693.     ULONG type;
  694.     HINI iniHandle;
  695.     int length;
  696.     Tcl_Obj *resultPtr;
  697. #ifdef VERBOSE
  698.     printf("TclOS2SetKey()\n");
  699.     fflush(stdout);
  700. #endif
  701.  
  702.     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
  703.     buffer = ckalloc(length + 1);
  704.     strcpy(buffer, keyName);
  705.     valueName = valueNameObj != NULL
  706.                              ? Tcl_GetStringFromObj(valueNameObj, &length)
  707.                              : NULL;
  708. #ifdef VERBOSE
  709.     printf("TclOS2SetKey(%s, %s)\n", keyName, valueName);
  710.     fflush(stdout);
  711. #endif
  712.  
  713.     if (typeObj == NULL) {
  714.         type = STRING;
  715.     } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
  716.             0, (int *) &type) != TCL_OK) {
  717.         if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
  718.             return TCL_ERROR;
  719.         }
  720.         Tcl_ResetResult(interp);
  721.     }
  722.  
  723.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
  724.             != TCL_OK) {
  725.         ckfree(buffer);
  726.         return TCL_ERROR;
  727.     }
  728.     ckfree(buffer);
  729.  
  730.     resultPtr = Tcl_GetObjResult(interp);
  731.  
  732.     if (type == STRING || type == SZ) {
  733.         char *data = dataObj != NULL ? Tcl_GetStringFromObj(dataObj, &length)
  734.                                      : NULL;
  735.  
  736.         ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName,
  737.                                   (PVOID)data, length);
  738. #ifdef VERBOSE
  739.         printf("PrfWriteProfileData(%x, %s, %s, <data>, %d) returns %d\n",
  740.                iniHandle, keyName, valueName, length, ret);
  741.         fflush(stdout);
  742. #endif
  743.     } else {
  744.         ULONG value;
  745.         if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
  746.             TclOS2CloseProfile(iniHandle);
  747.             return TCL_ERROR;
  748.         }
  749.  
  750.         ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName,
  751.                                  (PVOID)&value, sizeof(value));
  752. #ifdef VERBOSE
  753.         printf("PrfWriteProfileData(%x, %s, %s, %x, %d) returns %d\n",
  754.                iniHandle, keyName, valueName, value, sizeof(value), ret);
  755.         fflush(stdout);
  756. #endif
  757.     }
  758.     TclOS2CloseProfile(iniHandle);
  759.     if (ret != TRUE) {
  760.         Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
  761.         AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
  762.         return TCL_ERROR;
  763.     }
  764.     return TCL_OK;
  765. }
  766.  
  767. /*
  768.  *----------------------------------------------------------------------
  769.  *
  770.  * TclOS2OpenProfile --
  771.  *
  772.  *    This function parses a key name into the iniFile, application
  773.  *    and key parts and if necessary opens the iniFile. 
  774.  *
  775.  * Results:
  776.  *    The pointers to the start of the iniFile, application and key
  777.  *    names are returned in the iniFilePtr, keyNamePtr and valueNamePtr
  778.  *    variables.
  779.  *    The handle for the opened profile is returned in iniFilePtr.
  780.  *    In the case of using both user and system profiles, the full
  781.  *    of the user or system profiles are returned in iniFilePtr
  782.  *    separated by '\0'.
  783.  *    Returns a standard Tcl result.
  784.  *
  785.  *
  786.  * Side effects:
  787.  *    Modifies the name string by inserting nulls.
  788.  *    Opens any user specified profile.
  789.  *    A not-yet existing profile will be created empty by OS/2.
  790.  *
  791.  *----------------------------------------------------------------------
  792.  */
  793.  
  794. static int
  795. TclOS2OpenProfile(
  796.     Tcl_Interp *interp,        /* Current interpreter. */
  797.     char *name,
  798.     char **iniFilePtr,
  799.     char **keyNamePtr,
  800.     HINI *iniHandlePtr)
  801. {
  802.     char *rootName;
  803.     int result, index;
  804.     Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
  805. #ifdef VERBOSE
  806.     printf("TclOS2OpenProfile()\n");
  807.     fflush(stdout);
  808. #endif
  809.  
  810.     /*
  811.      * Split the key into host and root portions.
  812.      */
  813.  
  814.     *iniFilePtr = *keyNamePtr = NULL;
  815.     *iniHandlePtr = HINI_PROFILE;
  816.     rootName = name;
  817.  
  818.     /*
  819.      * Split into iniFile and application portions.
  820.      */
  821.  
  822.     for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
  823.         if (**keyNamePtr == '\\') {
  824.             **keyNamePtr = '\0';
  825.             (*keyNamePtr)++;
  826.             break;
  827.         }
  828.     }
  829.  
  830.     /*
  831.      * Look for a matching root name.
  832.      */
  833.  
  834. #ifdef VERBOSE
  835.     printf("    rootName %s\n", rootName);
  836.     fflush(stdout);
  837. #endif
  838.     rootObj = Tcl_NewStringObj(rootName, -1);
  839.     result = Tcl_GetIndexFromObj(NULL, rootObj, iniFileNames, "root name",
  840.             TCL_EXACT, &index);
  841.     Tcl_DecrRefCount(rootObj);
  842.     if (result != TCL_OK) {
  843.         /* Not BOTH, USER or SYSTEM, so assume a file name has been given */
  844.         *iniHandlePtr = PrfOpenProfile(TclOS2GetHAB(), rootName);
  845.         if (*iniHandlePtr == NULLHANDLE) {
  846. #ifdef VERBOSE
  847.             printf("    PrfOpenProfile %s ERROR %x\n", rootName, *iniFilePtr);
  848.             fflush(stdout);
  849. #endif
  850.             Tcl_AppendStringsToObj(resultPtr, "bad file name \"", rootName,
  851.                                    "\"", NULL);
  852.             return TCL_ERROR;
  853.         }
  854. #ifdef VERBOSE
  855.         printf("    PrfOpenProfile %s: HINI %x\n", rootName, *iniHandlePtr);
  856.         fflush(stdout);
  857. #endif
  858.     } else {
  859.         *iniHandlePtr = iniHandles[index];
  860.         /* Determine path of user/system profile */
  861.         *iniFilePtr = iniFileNames[index];
  862. #ifdef VERBOSE
  863.         printf("    standard profile %s: HINI %x (%s)\n", rootName,
  864.                *iniHandlePtr, *iniFilePtr);
  865.         fflush(stdout);
  866. #endif
  867.     }
  868.     return TCL_OK;
  869. }
  870.  
  871. /*
  872.  *----------------------------------------------------------------------
  873.  *
  874.  * TclOS2CloseProfile --
  875.  *
  876.  *    This function closes an iniFile.
  877.  *
  878.  * Results:
  879.  *    Only for a user-specified profile is actually closed; the user
  880.  *    and system profiles stay open all the time and cannot be closed
  881.  *    successfully anyway.
  882.  *    Returns a standard Tcl result.
  883.  *
  884.  *
  885.  * Side effects:
  886.  *    None.
  887.  *
  888.  *----------------------------------------------------------------------
  889.  */
  890.  
  891. static int
  892. TclOS2CloseProfile(
  893.     HINI iniHandle)
  894. {
  895. #ifdef VERBOSE
  896.     printf("TclOS2CloseProfile()\n");
  897.     fflush(stdout);
  898. #endif
  899.     if ( iniHandle != HINI_PROFILE && iniHandle != HINI_USERPROFILE &&
  900.          iniHandle != HINI_SYSTEMPROFILE) {
  901.         ret = PrfCloseProfile(iniHandle);
  902.         if (ret != TRUE) {
  903. #ifdef VERBOSE
  904.             printf("PrfCloseProfile(%d) ERROR %x\n", iniHandle,
  905.                    WinGetLastError(TclOS2GetHAB()));
  906. #endif
  907.             return TCL_ERROR;    /* Ignored anyway */
  908.         }
  909.     }
  910.     return TCL_OK;
  911. }
  912.  
  913. /*
  914.  *----------------------------------------------------------------------
  915.  *
  916.  * AppendSystemError --
  917.  *
  918.  *    This routine formats an OS/2 system error message and places
  919.  *    it into the interpreter result.
  920.  *
  921.  * Results:
  922.  *    None.
  923.  *
  924.  * Side effects:
  925.  *    None.
  926.  *
  927.  *----------------------------------------------------------------------
  928.  */
  929.  
  930. static void
  931. AppendSystemError(
  932.     Tcl_Interp *interp,        /* Current interpreter. */
  933.     ULONG error)        /* Result code from error. */
  934. {
  935.     char msgbuf[64];
  936.     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
  937. #ifdef VERBOSE
  938.     printf("AppendSystemError()\n");
  939.     fflush(stdout);
  940. #endif
  941.  
  942.     sprintf(msgbuf, "System Error %lx", error);
  943.     Tcl_SetErrorCode(interp, "OS/2", msgbuf, (char *) NULL);
  944.     Tcl_AppendToObj(resultPtr, msgbuf, -1);
  945. }
  946.  
  947. /*
  948.  *----------------------------------------------------------------------
  949.  *
  950.  * TclOS2GetAppNames --
  951.  *
  952.  *      This function enumerates the applications in a profile. If the
  953.  *      optional pattern is supplied, then only keys that match the
  954.  *      pattern will be returned.
  955.  *
  956.  * Results:
  957.  *      Returns the list of applications in the result object of the
  958.  *      interpreter, or an error message on failure.
  959.  *
  960.  * Side effects:
  961.  *      None.
  962.  *
  963.  *----------------------------------------------------------------------
  964.  */
  965.  
  966. static int
  967. TclOS2GetAppNames(
  968.     Tcl_Interp *interp,         /* Current interpreter. */
  969.     Tcl_Obj *iniFileObj,        /* Profile to enumerate. */
  970.     Tcl_Obj *patternObj)        /* Optional match pattern. */
  971. {
  972.     char *p, *buffer, *iniFile, *appName, *pattern;
  973.     char appList[ENUM_APPS];
  974.     HINI iniHandle;
  975.     int length;
  976.     ULONG bufMax;
  977.     Tcl_Obj *resultPtr;
  978.     int result = TCL_OK;
  979. #ifdef VERBOSE
  980.     printf("TclOS2GetAppNames()\n");
  981.     fflush(stdout);
  982. #endif
  983.     iniFile = Tcl_GetStringFromObj(iniFileObj, &length);
  984.     buffer = ckalloc(length + 1);
  985.     strcpy(buffer, iniFile);
  986.  
  987.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
  988.             != TCL_OK) {
  989.         ckfree(buffer);
  990.         return TCL_ERROR;
  991.     }
  992.     ckfree(buffer);
  993.  
  994.     bufMax = sizeof(appList);
  995.     if ( PrfQueryProfileData(iniHandle, NULL, NULL, &appList, &bufMax)
  996.          != TRUE) {
  997. #ifdef VERBOSE
  998.         printf("    PrfQueryProfileData ERROR %x\n",
  999.                WinGetLastError(TclOS2GetHAB()));
  1000.         fflush(stdout);
  1001. #endif
  1002.         TclOS2CloseProfile(iniHandle);
  1003.         return TCL_ERROR;
  1004.     }
  1005.     /*
  1006.      * appList now contains the names of the applications, separated by NULL
  1007.      * characters; the last is terminated with two successive NULLs.
  1008.      * bufMax now contains the total length of the list in appList excluding
  1009.      * the final NULL character.
  1010.      */
  1011. #ifdef VERBOSE
  1012.     printf("    PrfQueryProfileData returns %d in buffer (first %s)\n", bufMax,
  1013.            appList);
  1014.     fflush(stdout);
  1015. #endif
  1016.  
  1017.     if (patternObj) {
  1018.         pattern = Tcl_GetStringFromObj(patternObj, NULL);
  1019.     } else {
  1020.         pattern = NULL;
  1021.     }
  1022.  
  1023.     /*
  1024.      * Enumerate over the apps until we get to the double NULL, indicating the
  1025.      * end of the list.
  1026.      */
  1027.  
  1028.     resultPtr = Tcl_GetObjResult(interp);
  1029.     for (p = appList; *p != '\0'; p += strlen(p)+1) {
  1030.         if (pattern && !Tcl_StringMatch(p, pattern)) {
  1031. #ifdef VERBOSE
  1032.             printf("    Dismissing %s\n", p);
  1033.             fflush(stdout);
  1034. #endif
  1035.             continue;
  1036.         }
  1037. #ifdef VERBOSE
  1038.         printf("    Adding %s\n", p);
  1039.         fflush(stdout);
  1040. #endif
  1041.         result = Tcl_ListObjAppendElement(interp, resultPtr,
  1042.                 Tcl_NewStringObj(p, -1));
  1043.         if (result != TCL_OK) {
  1044.             break;
  1045.         }
  1046.     }
  1047.  
  1048.     TclOS2CloseProfile(iniHandle);
  1049.     return result;
  1050. }
  1051.  
  1052. /*
  1053.  *----------------------------------------------------------------------
  1054.  *
  1055.  * TclOS2GetAppKeyNames --
  1056.  *
  1057.  *      This function enumerates the keys of a given application in a
  1058.  *      profile.  If the optional pattern is supplied, then only key
  1059.  *      names that match the pattern will be returned.
  1060.  *
  1061.  * Results:
  1062.  *      Returns the list of key names in the result object of the
  1063.  *      interpreter, or an error message on failure.
  1064.  *
  1065.  * Side effects:
  1066.  *      None.
  1067.  *
  1068.  *----------------------------------------------------------------------
  1069.  */
  1070.  
  1071. static int
  1072. TclOS2GetAppKeyNames(
  1073.     Tcl_Interp *interp,         /* Current interpreter. */
  1074.     Tcl_Obj *appNameObj,        /* App to enumerate. */
  1075.     Tcl_Obj *patternObj)        /* Optional match pattern. */
  1076. {
  1077.     char *p, *buffer, *iniFile, *appName;
  1078.     char keyList[ENUM_KEYS];
  1079.     ULONG bufMax;
  1080.     HINI iniHandle;
  1081.     int length;
  1082.     Tcl_Obj *resultPtr;
  1083.     int result = TCL_OK;
  1084.     char *pattern;
  1085. #ifdef VERBOSE
  1086.     printf("TclOS2GetKeyNames()\n");
  1087.     fflush(stdout);
  1088. #endif
  1089.  
  1090.     appName = Tcl_GetStringFromObj(appNameObj, &length);
  1091.     buffer = ckalloc(length + 1);
  1092.     strcpy(buffer, appName);
  1093.  
  1094.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
  1095.             != TCL_OK) {
  1096.         ckfree(buffer);
  1097.         return TCL_ERROR;
  1098.     }
  1099.     ckfree(buffer);
  1100.  
  1101.     bufMax = sizeof(keyList);
  1102.     if ( PrfQueryProfileData(iniHandle, appName, NULL, &keyList, &bufMax)
  1103.          != TRUE) {
  1104. #ifdef VERBOSE
  1105.         printf("    PrfQueryProfileData ERROR %x\n",
  1106.                WinGetLastError(TclOS2GetHAB()));
  1107.         fflush(stdout);
  1108. #endif
  1109.         TclOS2CloseProfile(iniHandle);
  1110.         return TCL_ERROR;
  1111.     }
  1112.     /*
  1113.      * keyList now contains the names of the keys, separated by NULL characters;
  1114.      * the last is terminated with two successive NULLs.
  1115.      * bufMax now contains the total length of the list in keyList excluding
  1116.      * the final NULL character.
  1117.      */
  1118. #ifdef VERBOSE
  1119.     printf("    PrfQueryProfileData returns %d in buffer (first %s)\n", bufMax,
  1120.            keyList);
  1121.     fflush(stdout);
  1122. #endif
  1123.  
  1124.     if (patternObj) {
  1125.         pattern = Tcl_GetStringFromObj(patternObj, NULL);
  1126.     } else {
  1127.         pattern = NULL;
  1128.     }
  1129.  
  1130.     /*
  1131.      * Enumerate over the keys until we get to the double NULL, indicating the
  1132.      * end of the list.
  1133.      */
  1134.  
  1135.     resultPtr = Tcl_GetObjResult(interp);
  1136.     for (p = keyList; *p != '\0'; p += strlen(p)+1) {
  1137.         if (pattern && !Tcl_StringMatch(p, pattern)) {
  1138. #ifdef VERBOSE
  1139.             printf("    Dismissing %s\n", p);
  1140.             fflush(stdout);
  1141. #endif
  1142.             continue;
  1143.         }
  1144. #ifdef VERBOSE
  1145.         printf("    Adding %s\n", p);
  1146.         fflush(stdout);
  1147. #endif
  1148.         result = Tcl_ListObjAppendElement(interp, resultPtr,
  1149.                 Tcl_NewStringObj(p, -1));
  1150.         if (result != TCL_OK) {
  1151.             break;
  1152.         }
  1153.     }
  1154.  
  1155.     TclOS2CloseProfile(iniHandle);
  1156.     return result;
  1157. }
  1158.  
  1159. /*
  1160.  *----------------------------------------------------------------------
  1161.  *
  1162.  * TclOS2SetAppKey --
  1163.  *
  1164.  *      This function sets the contents of a profile value.  If
  1165.  *      the application or key does not exist, it will be created.  If it
  1166.  *      does exist, then the data will be replaced.
  1167.  *      Only writing as binary data and string is possible.
  1168.  *
  1169.  * Results:
  1170.  *      Returns a normal Tcl result.
  1171.  *
  1172.  * Side effects:
  1173.  *      May create new apps or keys.
  1174.  *
  1175.  *----------------------------------------------------------------------
  1176.  */
  1177.  
  1178. static int
  1179. TclOS2SetAppKey(
  1180.     Tcl_Interp *interp,         /* Current interpreter. */
  1181.     Tcl_Obj *appNameObj,        /* Name of application. */
  1182.     Tcl_Obj *keyNameObj,        /* Name of key to set. */
  1183.     Tcl_Obj *dataObj,           /* Data to be written. */
  1184.     Tcl_Obj *typeObj)           /* Type of data to be written. */
  1185. {
  1186.     char *buffer, *iniFile, *appName, *keyName;
  1187.     ULONG type;
  1188.     HINI iniHandle;
  1189.     int length;
  1190.     Tcl_Obj *resultPtr;
  1191. #ifdef VERBOSE
  1192.     printf("TclOS2SetKey()\n");
  1193.     fflush(stdout);
  1194. #endif
  1195.  
  1196.     appName = Tcl_GetStringFromObj(appNameObj, &length);
  1197.     buffer = ckalloc(length + 1);
  1198.     strcpy(buffer, appName);
  1199.     keyName = keyNameObj != NULL ? Tcl_GetStringFromObj(keyNameObj, &length)
  1200.                                  : NULL;
  1201. #ifdef VERBOSE
  1202.     printf("TclOS2SetKey(%s, %s)\n", appName, keyName);
  1203.     fflush(stdout);
  1204. #endif
  1205.  
  1206.     if (typeObj == NULL) {
  1207.         type = STRING;
  1208.     } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
  1209.             0, (int *) &type) != TCL_OK) {
  1210.         if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
  1211.             return TCL_ERROR;
  1212.         }
  1213.         Tcl_ResetResult(interp);
  1214.     }
  1215.  
  1216.     if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
  1217.             != TCL_OK) {
  1218.         ckfree(buffer);
  1219.         return TCL_ERROR;
  1220.     }
  1221.     ckfree(buffer);
  1222.  
  1223.     resultPtr = Tcl_GetObjResult(interp);
  1224.  
  1225.     if (type == STRING || type == SZ) {
  1226.         char *data = Tcl_GetStringFromObj(dataObj, &length);
  1227.  
  1228.         ret = PrfWriteProfileData(iniHandle, appName, (PSZ)keyName, (PVOID)data,
  1229.                                  length);
  1230. #ifdef VERBOSE
  1231.         printf("PrfWriteProfileData(%x, %s, %s, <data>, %d) returns %d\n",
  1232.                iniHandle, appName, keyName, length, ret);
  1233.         fflush(stdout);
  1234. #endif
  1235.     } else {
  1236.         ULONG value;
  1237.         if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
  1238.             TclOS2CloseProfile(iniHandle);
  1239.             return TCL_ERROR;
  1240.         }
  1241.  
  1242.         ret = PrfWriteProfileData(iniHandle, appName, (PSZ)keyName,
  1243.                                  (PVOID)&value, sizeof(value));
  1244. #ifdef VERBOSE
  1245.         printf("PrfWriteProfileData(%x, %s, %s, %x, %d) returns %d\n",
  1246.                iniHandle, appName, keyName, value, sizeof(value), ret);
  1247.         fflush(stdout);
  1248. #endif
  1249.     }
  1250.     TclOS2CloseProfile(iniHandle);
  1251.     if (ret != TRUE) {
  1252.         Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
  1253.         AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
  1254.         return TCL_ERROR;
  1255.     }
  1256.     return TCL_OK;
  1257. }
  1258.