io.trash: cross-platform vocab to send files to trash.
John Benediktsson
parent
d7d1b6fea1
commit
5e63f3b5d8
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: alien.c-types alien.strings alien.syntax classes.struct
|
||||
core-foundation io.encodings.utf8 io.trash kernel system ;
|
||||
|
||||
IN: io.trash.macosx
|
||||
|
||||
<PRIVATE
|
||||
|
||||
STRUCT: FSRef
|
||||
{ hidden UInt8[80] } ;
|
||||
|
||||
TYPEDEF: SInt32 OSStatus
|
||||
|
||||
TYPEDEF: UInt32 OptionBits
|
||||
|
||||
CONSTANT: noErr 0
|
||||
|
||||
CONSTANT: kFSFileOperationDefaultOptions HEX: 00
|
||||
CONSTANT: kFSFileOperationOverwrite HEX: 01
|
||||
CONSTANT: kFSFileOperationSkipSourcePermissionErrors HEX: 02
|
||||
CONSTANT: kFSFileOperationDoNotMoveAcrossVolumes HEX: 04
|
||||
CONSTANT: kFSFileOperationSkipPreflight HEX: 08
|
||||
|
||||
CONSTANT: kFSPathMakeRefDefaultOptions HEX: 00
|
||||
CONSTANT: kFSPathMakeRefDoNotFollowLeafSymlink HEX: 01
|
||||
|
||||
FUNCTION: OSStatus FSMoveObjectToTrashSync (
|
||||
FSRef* source,
|
||||
FSRef* target,
|
||||
OptionBits options
|
||||
) ;
|
||||
|
||||
FUNCTION: char* GetMacOSStatusCommentString (
|
||||
OSStatus err
|
||||
) ;
|
||||
|
||||
FUNCTION: OSStatus FSPathMakeRefWithOptions (
|
||||
UInt8* path,
|
||||
OptionBits options,
|
||||
FSRef* ref,
|
||||
Boolean* isDirectory
|
||||
) ;
|
||||
|
||||
: check-err ( err -- )
|
||||
dup noErr = [ drop ] [
|
||||
GetMacOSStatusCommentString utf8 alien>string throw
|
||||
] if ;
|
||||
|
||||
! FIXME: check isDirectory?
|
||||
|
||||
: <fs-ref> ( path -- fs-ref )
|
||||
utf8 string>alien
|
||||
kFSPathMakeRefDoNotFollowLeafSymlink
|
||||
FSRef <struct>
|
||||
[ f FSPathMakeRefWithOptions check-err ] keep ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: macosx send-to-trash ( path -- )
|
||||
<fs-ref> f kFSFileOperationDefaultOptions
|
||||
FSMoveObjectToTrashSync check-err ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
macosx
|
||||
|
|
@ -0,0 +1 @@
|
|||
Send files to the trash bin.
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: help.markup help.syntax io.trash ;
|
||||
|
||||
IN: io.trash
|
||||
|
||||
HELP: send-to-trash
|
||||
{ $values { "path" "a file path" } }
|
||||
{ $description
|
||||
"Send a file path to the trash bin."
|
||||
} ;
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: combinators system vocabs.loader ;
|
||||
|
||||
IN: io.trash
|
||||
|
||||
HOOK: send-to-trash os ( path -- )
|
||||
|
||||
{
|
||||
{ [ os macosx? ] [ "io.trash.macosx" ] }
|
||||
{ [ os unix? ] [ "io.trash.unix" ] }
|
||||
{ [ os winnt? ] [ "io.trash.windows" ] }
|
||||
} cond require
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
unix
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors calendar combinators.short-circuit environment
|
||||
formatting io io.directories io.encodings.utf8 io.files
|
||||
io.files.info io.files.info.unix io.files.types io.pathnames
|
||||
io.trash kernel math math.parser sequences system unix.stat
|
||||
unix.users ;
|
||||
|
||||
IN: io.trash.unix
|
||||
|
||||
! Implements the FreeDesktop.org Trash Specification 0.7
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: top-directory? ( path -- ? )
|
||||
dup ".." append-path [ link-status ] bi@
|
||||
[ [ st_dev>> ] bi@ = not ] [ [ st_ino>> ] bi@ = ] 2bi or ;
|
||||
|
||||
: top-directory ( path -- path' )
|
||||
[ dup top-directory? not ] [ ".." append-path ] while ;
|
||||
|
||||
: make-user-directory ( path -- )
|
||||
[ make-directories ] [ OCT: 700 set-file-permissions ] bi ;
|
||||
|
||||
: check-trash-path ( path -- )
|
||||
{
|
||||
[ file-info directory? ]
|
||||
[ sticky? ]
|
||||
[ link-info type>> +symbolic-link+ = not ]
|
||||
} 1&& [ "invalid trash path" throw ] unless ;
|
||||
|
||||
: trash-home ( -- path )
|
||||
"XDG_DATA_HOME" os-env
|
||||
home ".local/share" append-path or
|
||||
"Trash" append-path dup check-trash-path ;
|
||||
|
||||
: trash-1 ( root -- path )
|
||||
".Trash" append-path dup check-trash-path
|
||||
real-user-id number>string append-path ;
|
||||
|
||||
: trash-2 ( root -- path )
|
||||
real-user-id ".Trash-%d" sprintf append-path ;
|
||||
|
||||
: trash-path ( path -- path' )
|
||||
top-directory dup trash-home top-directory = [
|
||||
drop trash-home
|
||||
] [
|
||||
dup ".Trash" append-path exists?
|
||||
[ trash-1 ] [ trash-2 ] if
|
||||
[ make-user-directory ] keep
|
||||
] if ;
|
||||
|
||||
: (safe-file-name) ( path counter -- path' )
|
||||
[
|
||||
[ parent-directory ]
|
||||
[ file-stem ]
|
||||
[ file-extension dup [ "." prepend ] when ] tri
|
||||
] dip swap "%s%s %s%s" sprintf ;
|
||||
|
||||
: safe-file-name ( path -- path' )
|
||||
dup 0 [ over exists? ] [
|
||||
[ parent-directory to-directory ] [ 1 + ] bi*
|
||||
[ (safe-file-name) ] keep
|
||||
] while drop nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: unix send-to-trash ( path -- )
|
||||
dup trash-path [
|
||||
"files" append-path [ make-user-directory ] keep
|
||||
to-directory safe-file-name
|
||||
] [
|
||||
"info" append-path [ make-user-directory ] keep
|
||||
to-directory ".trashinfo" append [ over ] dip utf8 [
|
||||
"[Trash Info]" write nl
|
||||
"Path=" write write nl
|
||||
"DeletionDate=" write
|
||||
now "%Y-%m-%dT%H:%M:%S" strftime write nl
|
||||
] with-file-writer
|
||||
] bi move-file ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
windows
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors alien.c-types alien.data alien.strings
|
||||
alien.syntax classes.struct classes.struct.packed destructors
|
||||
kernel io.encodings.utf16n io.trash libc math sequences system
|
||||
windows.types ;
|
||||
|
||||
IN: io.trash.windows
|
||||
|
||||
<PRIVATE
|
||||
|
||||
LIBRARY: shell32
|
||||
|
||||
TYPEDEF: WORD FILEOP_FLAGS
|
||||
|
||||
PACKED-STRUCT: SHFILEOPSTRUCTW
|
||||
{ hwnd HWND }
|
||||
{ wFunc UINT }
|
||||
{ pFrom LPCWSTR* }
|
||||
{ pTo LPCWSTR* }
|
||||
{ fFlags FILEOP_FLAGS }
|
||||
{ fAnyOperationsAborted BOOL }
|
||||
{ hNameMappings LPVOID }
|
||||
{ lpszProgressTitle LPCWSTR } ;
|
||||
|
||||
FUNCTION: int SHFileOperationW ( SHFILEOPSTRUCTW* lpFileOp ) ;
|
||||
|
||||
CONSTANT: FO_MOVE HEX: 0001
|
||||
CONSTANT: FO_COPY HEX: 0002
|
||||
CONSTANT: FO_DELETE HEX: 0003
|
||||
CONSTANT: FO_RENAME HEX: 0004
|
||||
|
||||
CONSTANT: FOF_MULTIDESTFILES HEX: 0001
|
||||
CONSTANT: FOF_CONFIRMMOUSE HEX: 0002
|
||||
CONSTANT: FOF_SILENT HEX: 0004
|
||||
CONSTANT: FOF_RENAMEONCOLLISION HEX: 0008
|
||||
CONSTANT: FOF_NOCONFIRMATION HEX: 0010
|
||||
CONSTANT: FOF_WANTMAPPINGHANDLE HEX: 0020
|
||||
CONSTANT: FOF_ALLOWUNDO HEX: 0040
|
||||
CONSTANT: FOF_FILESONLY HEX: 0080
|
||||
CONSTANT: FOF_SIMPLEPROGRESS HEX: 0100
|
||||
CONSTANT: FOF_NOCONFIRMMKDIR HEX: 0200
|
||||
CONSTANT: FOF_NOERRORUI HEX: 0400
|
||||
CONSTANT: FOF_NOCOPYSECURITYATTRIBS HEX: 0800
|
||||
CONSTANT: FOF_NORECURSION HEX: 1000
|
||||
CONSTANT: FOF_NO_CONNECTED_ELEMENTS HEX: 2000
|
||||
CONSTANT: FOF_WANTNUKEWARNING HEX: 4000
|
||||
CONSTANT: FOF_NORECURSEREPARSE HEX: 8000
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: windows send-to-trash ( path -- )
|
||||
[
|
||||
utf16n string>alien B{ 0 0 } append
|
||||
malloc-byte-array &free
|
||||
|
||||
SHFILEOPSTRUCTW <struct>
|
||||
f >>hwnd
|
||||
FO_DELETE >>wFunc
|
||||
swap >>pFrom
|
||||
f >>pTo
|
||||
FOF_ALLOWUNDO
|
||||
FOF_NOCONFIRMATION bitor
|
||||
FOF_NOERRORUI bitor
|
||||
FOF_SILENT bitor >>fFlags
|
||||
|
||||
SHFileOperationW [ throw ] unless-zero
|
||||
|
||||
] with-destructors ;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue