extra/file-picker/windows/windows.factor

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