FEAT: implemented request-dir on Windows

related to: Oldes/Rebol-wishes#29

Author: Oldes

src/boot/natives.reb

@@ -936,11 +936,23 @@ evoke: native [
 
 request-file: native [
 	{Asks user to select a file and returns full file path (or block of paths).}
-	/save "File save mode"
+	/save  "File save mode"
 	/multi "Allows multiple file selection, returned as a block"
-	/file name [file!] "Default file name or directory"
-	/title text [string!] "Window title"
-	/filter list [block!] "Block of filters (filter-name filter)"
+	/file  "Default file name or directory"
+	 name  [file!]
+	/title "Window title"
+	 text  [string!]
+	/filter "Block of filters (filter-name filter)"
+	 list  [block!]
+]
+
+request-dir: native [
+	{Asks user to select a directory and returns full directory path (or block of paths).}
+	/title "Change heading on request"
+	 text  [string!]
+	/dir   "Set starting directory" 
+	 name  [file!]
+	/keep  "Keep previous directory path"
 ]
 
 ascii?: native [

src/core/n-io.c

@@ -973,6 +973,65 @@ static REBSER *Read_All_File(char *fname)
 
 	return ser ? R_RET : R_NONE;
 #else
+	Trap0(RE_FEATURE_NA);
+	return R_NONE;
+#endif
+}
+
+
+/***********************************************************************
+**
+*/	REBNATIVE(request_dir)
+/*
+***********************************************************************/
+{
+#ifdef TO_WINDOWS
+	REBRFR fr = {0};
+	REBSER *ser;
+	REBINT n;
+
+	fr.files = OS_MAKE(MAX_DIR_REQ_BUF);
+	fr.len = MAX_DIR_REQ_BUF/sizeof(REBCHR) - 4; // reserve for trailing slash and null 
+	fr.files[0] = 0;
+
+	DISABLE_GC;
+
+	if (D_REF(ARG_REQUEST_DIR_DIR)) {
+		ser = Value_To_OS_Path(D_ARG(ARG_REQUEST_DIR_NAME), TRUE);
+		fr.dir = (REBCHR*)(ser->data);
+		n = ser->tail;
+		if (fr.dir[n-1] != OS_DIR_SEP) {
+			if (n+2 > fr.len) n = fr.len - 2;
+			COPY_STR(fr.files, (REBCHR*)(ser->data), n);
+			fr.files[n] = 0;
+		}
+	}
+
+	if (D_REF(ARG_REQUEST_DIR_TITLE))
+		fr.title = Val_Str_To_OS(D_ARG(ARG_REQUEST_DIR_TEXT));
+	else
+		fr.title = L"Select Folder";
+
+	if (D_REF(ARG_REQUEST_DIR_KEEP)) SET_FLAG(fr.flags, FRF_KEEP);
+
+	if (OS_REQUEST_DIR(&fr)) {
+		REBCNT len = (REBCNT)LEN_STR(fr.files);
+		// Windows may return path without trailing slash, so just add it if missing
+		if (fr.files[len-1] != '\\') {
+			fr.files[len++]  = '\\';
+			fr.files[len  ]  = 0;
+		}
+		ser = To_REBOL_Path(fr.files, len, OS_WIDE, 0);
+		Set_Series(REB_FILE, D_RET, ser);
+	} else
+		ser = 0;
+
+	ENABLE_GC;
+	OS_FREE(fr.files);
+
+	return ser ? R_RET : R_NONE;
+#else
+	Trap0(RE_FEATURE_NA);
 	return R_NONE;
 #endif
 }

src/include/reb-filereq.h

@@ -27,6 +27,7 @@
 ***********************************************************************/
 
 #define MAX_FILE_REQ_BUF (16*1024)
+#define MAX_DIR_REQ_BUF  ( 1*1024) // windows has path limit 260 chars by default
 
 #pragma pack(4)
 typedef struct Reb_File_Requestor {

src/os/win32/host-lib.c

@@ -56,6 +56,7 @@
 #include <stdio.h>
 #include <windows.h>
 #include <process.h>
+#include <ShlObj.h>  // used for OS_Request_Dir
 
 #include "reb-host.h"
 #include "host-lib.h"
@@ -1331,3 +1332,65 @@ static void *Task_Ready;
 	return ret;
 }
 
+static LPITEMIDLIST lpLastBrowseFolder = NULL;
+static BOOL bBrowseFolderInit = FALSE;
+static BFFCALLBACK BrowseCallbackProc(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData) {
+	// Using this callback to set default folder.
+	// The SendMessage in BFFM_SELCHANGED is there to update focus on the directory
+	// Without it it would select the folder on init, but the folder could not be visible.
+	REBOOL set = FALSE;
+
+	switch (uMsg) {
+	case BFFM_INITIALIZED:
+		bBrowseFolderInit = TRUE;
+		set = TRUE;
+		break;
+	case BFFM_SELCHANGED:
+		if (bBrowseFolderInit) {
+			bBrowseFolderInit = FALSE;
+			set = TRUE;
+		}
+		break;
+	}
+	if (lpData && set) {
+		SendMessage(hwnd, BFFM_SETSELECTION, lpLastBrowseFolder != lpData, lpData);
+	}
+	return 0;
+}
+/***********************************************************************
+**
+*/	REBOOL OS_Request_Dir(REBRFR *fr)
+/*
+***********************************************************************/
+{
+	BROWSEINFO bInfo = {0};
+	REBOOL keep = GET_FLAG(fr->flags, FRF_KEEP);
+	REBCHR *dir = fr->dir;
+
+	//bInfo.hwndOwner = Owner window // Must find a way to set this
+	bInfo.pidlRoot = NULL; 
+	bInfo.pszDisplayName = fr->files; // Address of a buffer to receive the name of the folder selected by the user
+	bInfo.lpszTitle = fr->title;      // Title of the dialog
+	bInfo.ulFlags = BIF_USENEWUI | BIF_RETURNONLYFSDIRS;
+	bInfo.lpfn = BrowseCallbackProc;
+	// start in dir location is used /dir
+	// else use last keeped result if used /keep
+	// else NULL if no /keep and /dir is there
+	bInfo.lParam = (dir) ? dir : (keep) ? lpLastBrowseFolder : NULL;
+	bInfo.iImage = -1;
+
+	LPITEMIDLIST lpItem = SHBrowseForFolder( &bInfo);
+	if(lpItem == NULL) {
+		// nothing selected
+		return FALSE;
+	}
+	if (keep) {
+		// release last result if there was any
+		if(lpLastBrowseFolder)
+			CoTaskMemFree(lpLastBrowseFolder);
+		// and store result for next request
+		lpLastBrowseFolder = lpItem;
+	}
+	SHGetPathFromIDList(lpItem, fr->files);
+	return TRUE;
+}

src/tools/make-headers.reb

@@ -348,6 +348,7 @@ acts: load %../boot/natives.reb
 foreach word [
 	checksum
 	request-file
+	request-dir
 ] [make-arg-enums word]
 
 ;?? output