* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.63 $
- * $Date: 2000/04/07 16:20:53 $
+ * $Revision: 1.64 $
+ * $Date: 2000/04/10 09:40:03 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static Void local toggleSet ( Char,Bool );
static Void local togglesIn ( Bool );
static Void local optionInfo ( Void );
-#if USE_REGISTRY
-static String local optionsToStr ( Void );
-#endif
static Void local readOptions ( String );
static Bool local processOption ( String );
static Void local setHeapSize ( String );
#endif
hugsPath = strCopy(HUGSPATH);
readOptions("-p\"%s> \" -r$$");
-#if USE_REGISTRY
- projectPath = strCopy(readRegChildStrings(HKEY_LOCAL_MACHINE,ProjectRoot,
- "HUGSPATH", PATHSEP, ""));
- readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
- readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
-#endif /* USE_REGISTRY */
readOptions(fromEnv("STGHUGSFLAGS",""));
strncpy(argv_0_orig,argv[0],1000); /* startupHaskell mangles argv[0] */
Putchar('\n');
}
-#if USE_REGISTRY
-#define PUTC(c) \
- *next++=(c)
-
-#define PUTS(s) \
- strcpy(next,s); \
- next+=strlen(next)
-
-#define PUTInt(optc,i) \
- sprintf(next,"-%c%d",optc,i); \
- next+=strlen(next)
-
-#define PUTStr(c,s) \
- next=PUTStr_aux(next,c,s)
-
-static String local PUTStr_aux ( String,Char, String));
-
-static String local PUTStr_aux(next,c,s)
-String next;
-Char c;
-String s; {
- if (s) {
- String t = 0;
- sprintf(next,"-%c\"",c);
- next+=strlen(next);
- for(t=s; *t; ++t) {
- PUTS(unlexChar(*t,'"'));
- }
- next+=strlen(next);
- PUTS("\" ");
- }
- return next;
-}
-
-static String local optionsToStr() { /* convert options to string */
- static char buffer[2000];
- String next = buffer;
-
- Int i;
- for (i=0; toggle[i].c; ++i) {
- PUTC(*toggle[i].flag ? '+' : '-');
- PUTC(toggle[i].c);
- PUTC(' ');
- }
- PUTS(haskell98 ? "+98 " : "-98 ");
- PUTInt('h',hpSize); PUTC(' ');
- PUTStr('p',prompt);
- PUTStr('r',repeatStr);
- PUTStr('P',hugsPath);
- PUTStr('E',hugsEdit);
- PUTInt('c',cutoff); PUTC(' ');
-#if USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
- PUTStr('F',preprocessor);
-#endif
- PUTC('\0');
- return buffer;
-}
-#endif /* USE_REGISTRY */
-
#undef PUTC
#undef PUTS
#undef PUTInt
hpSize = MAXIMUMHEAP;
if (initDone && hpSize != heapSize) {
/* ToDo: should this use a message box in winhugs? */
-#if USE_REGISTRY
- FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
-#else
FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
-#endif
} else {
heapSize = hpSize;
}
EEND_NO_LONGJMP;
}
} while ((s=readFilename())!=0);
-#if USE_REGISTRY
- writeRegString("Options", optionsToStr());
-#endif
}
else
optionInfo();
* included in the distribution.
*
* $RCSfile: machdep.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/04/05 16:57:18 $
+ * $Revision: 1.28 $
+ * $Date: 2000/04/10 09:40:03 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
#endif
/* --------------------------------------------------------------------------
- * Prototypes for registry reading
- * ------------------------------------------------------------------------*/
-
-#if USE_REGISTRY
-
-/* where have we hidden things in the registry? */
-#if HSCRIPT
-#define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\")
-#endif
-
-#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
-#define ProjectRoot ("SOFTWARE\\Haskell\\Projects\\")
-
-static Bool local createKey ( HKEY, String, PHKEY, REGSAM );
-static Bool local queryValue ( HKEY, String, String, LPDWORD, LPBYTE, DWORD );
-static Bool local setValue ( HKEY, String, String, DWORD, LPBYTE, DWORD );
-static String local readRegString ( HKEY, String, String, String );
-static Int local readRegInt ( String,Int );
-static Bool local writeRegString ( String,String );
-static Bool local writeRegInt ( String,Int );
-
-static String local readRegChildStrings ( HKEY, String, String, Char, String );
-#endif /* USE_REGISTRY */
-
-/* --------------------------------------------------------------------------
* Find information about a file:
* ------------------------------------------------------------------------*/
String nm; {
/* AC, 1/21/99: modified to search hugsPath first, then projectPath */
String s = findMPathname(along,nm,hugsPath);
-#if USE_REGISTRY
-#if 0
- ToDo:
- if (s==NULL) {
- s = findMPathname(along,nm,projectPath);
- }
-#endif /* 0 */
-#endif /* USE_REGISTRY */
return s ? s : normPath(searchBuf);
}
#endif /* HAVE_SNPRINTF */
/* --------------------------------------------------------------------------
- * Read/write values from/to the registry
- *
- * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
- * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
- * user entry doesn't exist).
- *
- * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
- * ------------------------------------------------------------------------*/
-
-#if USE_REGISTRY
-
-#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
-
-static Bool local createKey ( HKEY, PHKEY, REGSAM );
-static Bool local queryValue ( HKEY, String, LPDWORD, LPBYTE, DWORD );
-static Bool local setValue ( HKEY, String, DWORD, LPBYTE, DWORD );
-
-static Bool local createKey(hKey, phRootKey, samDesired)
-HKEY hKey;
-PHKEY phRootKey;
-REGSAM samDesired; {
- DWORD dwDisp;
- return RegCreateKeyEx(hKey, HugsRoot,
- 0, "", REG_OPTION_NON_VOLATILE,
- samDesired, NULL, phRootKey, &dwDisp)
- == ERROR_SUCCESS;
-}
-
-static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
-HKEY hKey;
-String regPath;
-String var;
-LPDWORD type;
-LPBYTE buf;
-DWORD bufSize; {
- HKEY hRootKey;
-
- if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
- return FALSE;
- } else {
- LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
- RegCloseKey(hRootKey);
- return (res == ERROR_SUCCESS);
- }
-}
-
-static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
-HKEY hKey;
-String regPath;
-String var;
-DWORD type;
-LPBYTE buf;
-DWORD bufSize; {
- HKEY hRootKey;
-
- if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
- return FALSE;
- } else {
- LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
- RegCloseKey(hRootKey);
- return (res == ERROR_SUCCESS);
- }
-}
-
-static String local readRegString(key,regPath,var,def) /* read String from registry */
-HKEY key;
-String regPath;
-String var;
-String def; {
- static char buf[300];
- DWORD type;
- if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
- && type == REG_SZ) {
- return (String)buf;
- } else {
- return def;
- }
-}
-
-static Int local readRegInt(var, def) /* read Int from registry */
-String var;
-Int def; {
- DWORD buf;
- DWORD type;
-
- if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
- (LPBYTE)&buf, sizeof(buf))
- && type == REG_DWORD) {
- return (Int)buf;
- } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
- (LPBYTE)&buf, sizeof(buf))
- && type == REG_DWORD) {
- return (Int)buf;
- } else {
- return def;
- }
-}
-
-static Bool local writeRegString(var,val) /* write String to registry */
-String var;
-String val; {
- if (NULL == val) {
- val = "";
- }
- return setValue(HKEY_CURRENT_USER, HugsRoot, var,
- REG_SZ, (LPBYTE)val, lstrlen(val)+1);
-}
-
-static Bool local writeRegInt(var,val) /* write String to registry */
-String var;
-Int val; {
- return setValue(HKEY_CURRENT_USER, HugsRoot, var,
- REG_DWORD, (LPBYTE)&val, sizeof(val));
-}
-
-#endif /* USE_REGISTRY */
-
-/* --------------------------------------------------------------------------
* Things to do with the argv/argc and the env
* ------------------------------------------------------------------------*/
projects / ghc-hetmet.git / commitdiff