--- /dev/null
+John Benediktsson
--- /dev/null
+! 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 ;
+
+
--- /dev/null
+Send files to the trash bin.
--- /dev/null
+! 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."
+} ;
--- /dev/null
+! 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
+
--- /dev/null
+! 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 ;
+
+
--- /dev/null
+! 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 ;
+
+
+
projects / factor.git / commitdiff