extra/file-picker/windows/windows.factor

   1 USING: accessors alien.c-types alien.data alien.strings
   2 alien.syntax classes.struct destructors file-picker
   3 io.encodings.string io.encodings.utf8 kernel libc literals math
   4 system windows windows.kernel32 windows.shell32 windows.types
   5 windows.user32 ;
   6 IN: file-picker.windows
   7 LIBRARY: shell32
   8
   9 TYPEDEF: void* PIDLIST_ABSOLUTE
  10 TYPEDEF: void* PCIDLIST_ABSOLUTE
  11 TYPEDEF: void* BFFCALLBACK
  12
  13 FUNCTION: HRESULT SHGetFolderLocation (
  14     HWND hwndOwner,
  15     int nFolder,
  16     HANDLE hToken,
  17     DWORD dwReserved,
  18     PIDLIST_ABSOLUTE* ppidl
  19 ) ;
  20
  21 STRUCT: BROWSEINFO
  22   { hwndOwner HWND }
  23   { pidlRoot PCIDLIST_ABSOLUTE }
  24   { pszDisplayName LPTSTR }
  25   { lpszTitle LPCTSTR }
  26   { ulFlags UINT }
  27   { lpfn BFFCALLBACK }
  28   { lParam LPARAM }
  29   { iImage int } ;
  30
  31 CONSTANT: BIF_RETURNONLYFSDIRS 0x00000001
  32 CONSTANT: BIF_DONTGOBELOWDOMAIN 0x00000002
  33 CONSTANT: BIF_STATUSTEXT 0x00000004
  34 CONSTANT: BIF_RETURNFSANCESTORS 0x00000008
  35 CONSTANT: BIF_EDITBOX 0x00000010
  36 CONSTANT: BIF_VALIDATE 0x00000020
  37 CONSTANT: BIF_NEWDIALOGSTYLE 0x00000040
  38 CONSTANT: BIF_BROWSEINCLUDEURLS 0x00000080
  39 CONSTANT: BIF_USENEWUI flags{ BIF_EDITBOX BIF_NEWDIALOGSTYLE }
  40 CONSTANT: BIF_UAHINT 0x00000100
  41 CONSTANT: BIF_NONEWFOLDERBUTTON 0x00000200
  42 CONSTANT: BIF_NOTRANSLATETARGETS 0x00000400
  43 CONSTANT: BIF_BROWSEFORCOMPUTER 0x00001000
  44 CONSTANT: BIF_BROWSEFORPRINTER 0x00002000
  45 CONSTANT: BIF_BROWSEINCLUDEFILES 0x00004000
  46 CONSTANT: BIF_SHAREABLE 0x00008000
  47 CONSTANT: BIF_BROWSEFILEJUNCTIONS 0x00010000
  48
  49 FUNCTION: PIDLIST_ABSOLUTE SHBrowseForFolder (
  50     BROWSEINFO* lpbi
  51 ) ;
  52
  53 FUNCTION: BOOL SHGetPathFromIDList (
  54   PCIDLIST_ABSOLUTE pidl,
  55   LPTSTR pszPath
  56 ) ;
  57
  58
  59 M: windows open-file-dialog
  60     [
  61         BROWSEINFO <struct>
  62             GetDesktopWindow >>hwndOwner
  63             "Select a file or folder" utf8 malloc-string &free >>lpszTitle
  64             BIF_BROWSEINCLUDEFILES >>ulFlags
  65         SHBrowseForFolder [
  66             MAX_UNICODE_PATH 1 + malloc &free [ SHGetPathFromIDList ] keep
  67             swap [ utf8 alien>string ] [ drop f ] if
  68         ] [
  69             f
  70         ] if*
  71     ] with-destructors ;
  72
  73 M: windows save-file-dialog ;