]> gitweb.factorcode.org Git - factor.git/commitdiff
file-picker.windows: mock up some code for windows.
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 15 Dec 2014 23:36:03 +0000 (15:36 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Mon, 15 Dec 2014 23:36:03 +0000 (15:36 -0800)
extra/file-picker/windows/windows.factor

index d8a9dfacb6ae07976bc6a017fbe389201607829d..528a8bfa602565e21fe07d608b17e713701dc408 100644 (file)
@@ -1 +1,69 @@
+USING: file-picker windows.shell32 windows.types ;
 IN: file-picker.windows
+
+LIBRARY: shell32
+
+TYPEDEF: void* PIDLIST_ABSOLUTE
+TYPEDEF: void* BFFCALLBACK
+
+FUNCTION: HRESULT SHGetFolderLocation (
+    HWND hwndOwner,
+    int nFolder,
+    HANDLE hToken,
+    DWORD dwReserved,
+    PIDLIST_ABSOLUTE* ppidl
+) ;
+
+STRUCT: BROWSEINFO
+  { hwndOwner HWND }
+  { pidlRoot PCIDLIST_ABSOLUTE }
+  { pszDisplayName LPTSTR }
+  { lpszTitle LPCTSTR }
+  { ulFlags UINT }
+  { lpfn BFFCALLBACK }
+  { lParam LPARAM }
+  { iImage int }
+} ;
+
+CONSTANT: BIF_RETURNONLYFSDIRS 0x00000001
+CONSTANT: BIF_DONTGOBELOWDOMAIN 0x00000002
+CONSTANT: BIF_STATUSTEXT 0x00000004
+CONSTANT: BIF_RETURNFSANCESTORS 0x00000008
+CONSTANT: BIF_EDITBOX 0x00000010
+CONSTANT: BIF_VALIDATE 0x00000020
+CONSTANT: BIF_NEWDIALOGSTYLE 0x00000040
+CONSTANT: BIF_BROWSEINCLUDEURLS 0x00000080
+CONSTANT: BIF_USENEWUI flags{ BIF_EDITBOX BIF_NEWDIALOGSTYLE }
+CONSTANT: BIF_UAHINT 0x00000100
+CONSTANT: BIF_NONEWFOLDERBUTTON 0x00000200
+CONSTANT: BIF_NOTRANSLATETARGETS 0x00000400
+CONSTANT: BIF_BROWSEFORCOMPUTER 0x00001000
+CONSTANT: BIF_BROWSEFORPRINTER 0x00002000
+CONSTANT: BIF_BROWSEINCLUDEFILES 0x00004000
+CONSTANT: BIF_SHAREABLE 0x00008000
+CONSTANT: BIF_BROWSEFILEJUNCTIONS 0x00010000
+
+FUNCTION: PIDLIST_ABSOLUTE SHBrowseForFolder (
+    BROWSEINFO* lpbi
+) ;
+
+FUNCTION: BOOL SHGetPathFromIDList (
+  PCIDLIST_ABSOLUTE pidl,
+  LPTSTR pszPath
+) ;
+
+
+M: windows open-file-dialog
+    BROWSEINFO <struct>
+        GetDesktopWindow >>hwndOwner
+        0 CSIDL_PERSONAL 0 0 SHGetFolderLocation >>pidlRoot
+        "Select a file or folder" >>lpszTitle
+        BIF_BROWSEINCLUDEFILES >>ulFlags
+    SHBrowseForFolder [
+        void* <ref> [ SHGetPathFromIDList ] keep
+        alien>native-string
+    ] [
+        f
+    ] if* ;
+
+M: windows save-file-dialog ;