Fix quirk in open-in-explorer -- msft explorer wouldn't go to previous directory correctly if / was a path separator

db4
Doug Coleman 2010-02-17 16:42:53 -06:00
parent eb2f6e43d9
commit a0b3a370b8
2 changed files with 6 additions and 4 deletions

View File

@ -5,7 +5,8 @@ io.encodings.ascii kernel namespaces
sequences locals system splitting tools.deploy.backend sequences locals system splitting tools.deploy.backend
tools.deploy.config tools.deploy.config.editor assocs hashtables tools.deploy.config tools.deploy.config.editor assocs hashtables
prettyprint combinators windows.kernel32 windows.shell32 windows.user32 prettyprint combinators windows.kernel32 windows.shell32 windows.user32
alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico ; alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico
io.files.windows.nt ;
IN: tools.deploy.windows IN: tools.deploy.windows
CONSTANT: app-icon-resource-id "APPICON" CONSTANT: app-icon-resource-id "APPICON"
@ -22,6 +23,10 @@ CONSTANT: app-icon-resource-id "APPICON"
dup copy-dll dup copy-dll
deploy-ui? get ".exe" ".com" ? copy-vm ; deploy-ui? get ".exe" ".com" ? copy-vm ;
: open-in-explorer ( dir -- )
[ f "open" ] dip absolute-path normalize-separators
f f SW_SHOWNORMAL ShellExecute drop ;
: embed-ico ( vm vocab -- ) : embed-ico ( vm vocab -- )
dup vocab-windows-icon-path vocab-append-path dup exists? dup vocab-windows-icon-path vocab-append-path dup exists?
[ binary file-contents app-icon-resource-id embed-icon-resource ] [ binary file-contents app-icon-resource-id embed-icon-resource ]

View File

@ -87,9 +87,6 @@ ALIAS: SHGetFolderPath SHGetFolderPathW
FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ; FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
ALIAS: ShellExecute ShellExecuteW ALIAS: ShellExecute ShellExecuteW
: open-in-explorer ( dir -- )
[ f "open" ] dip absolute-path f f SW_SHOWNORMAL ShellExecute drop ;
: shell32-directory ( n -- str ) : shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT f swap f SHGFP_TYPE_DEFAULT
MAX_UNICODE_PATH <ushort-array> MAX_UNICODE_PATH <ushort-array>