From 5e63f3b5d8e901690c924084e0fe33337de4c432 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 19 Aug 2011 14:26:32 -0700
Subject: [PATCH] io.trash: cross-platform vocab to send files to trash.

---
 extra/io/trash/authors.txt            |  1 +
 extra/io/trash/macosx/macosx.factor   | 65 +++++++++++++++++++++
 extra/io/trash/macosx/platforms.txt   |  1 +
 extra/io/trash/summary.txt            |  1 +
 extra/io/trash/trash-docs.factor      | 12 ++++
 extra/io/trash/trash.factor           | 15 +++++
 extra/io/trash/unix/platforms.txt     |  1 +
 extra/io/trash/unix/unix.factor       | 83 +++++++++++++++++++++++++++
 extra/io/trash/windows/platforms.txt  |  1 +
 extra/io/trash/windows/windows.factor | 73 +++++++++++++++++++++++
 10 files changed, 253 insertions(+)
 create mode 100644 extra/io/trash/authors.txt
 create mode 100644 extra/io/trash/macosx/macosx.factor
 create mode 100644 extra/io/trash/macosx/platforms.txt
 create mode 100644 extra/io/trash/summary.txt
 create mode 100644 extra/io/trash/trash-docs.factor
 create mode 100644 extra/io/trash/trash.factor
 create mode 100644 extra/io/trash/unix/platforms.txt
 create mode 100644 extra/io/trash/unix/unix.factor
 create mode 100644 extra/io/trash/windows/platforms.txt
 create mode 100644 extra/io/trash/windows/windows.factor

diff --git a/extra/io/trash/authors.txt b/extra/io/trash/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/io/trash/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/io/trash/macosx/macosx.factor b/extra/io/trash/macosx/macosx.factor
new file mode 100644
index 0000000000..456afbdfb2
--- /dev/null
+++ b/extra/io/trash/macosx/macosx.factor
@@ -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 ;
+
+
diff --git a/extra/io/trash/macosx/platforms.txt b/extra/io/trash/macosx/platforms.txt
new file mode 100644
index 0000000000..6e806f449e
--- /dev/null
+++ b/extra/io/trash/macosx/platforms.txt
@@ -0,0 +1 @@
+macosx
diff --git a/extra/io/trash/summary.txt b/extra/io/trash/summary.txt
new file mode 100644
index 0000000000..b8c0053d2b
--- /dev/null
+++ b/extra/io/trash/summary.txt
@@ -0,0 +1 @@
+Send files to the trash bin.
diff --git a/extra/io/trash/trash-docs.factor b/extra/io/trash/trash-docs.factor
new file mode 100644
index 0000000000..a88e3165be
--- /dev/null
+++ b/extra/io/trash/trash-docs.factor
@@ -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."
+} ;
diff --git a/extra/io/trash/trash.factor b/extra/io/trash/trash.factor
new file mode 100644
index 0000000000..50efc912af
--- /dev/null
+++ b/extra/io/trash/trash.factor
@@ -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
+
diff --git a/extra/io/trash/unix/platforms.txt b/extra/io/trash/unix/platforms.txt
new file mode 100644
index 0000000000..509143d863
--- /dev/null
+++ b/extra/io/trash/unix/platforms.txt
@@ -0,0 +1 @@
+unix
diff --git a/extra/io/trash/unix/unix.factor b/extra/io/trash/unix/unix.factor
new file mode 100644
index 0000000000..ba604079e9
--- /dev/null
+++ b/extra/io/trash/unix/unix.factor
@@ -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 ;
+
+
diff --git a/extra/io/trash/windows/platforms.txt b/extra/io/trash/windows/platforms.txt
new file mode 100644
index 0000000000..8e1a55995e
--- /dev/null
+++ b/extra/io/trash/windows/platforms.txt
@@ -0,0 +1 @@
+windows
diff --git a/extra/io/trash/windows/windows.factor b/extra/io/trash/windows/windows.factor
new file mode 100644
index 0000000000..3ed3bf0dc7
--- /dev/null
+++ b/extra/io/trash/windows/windows.factor
@@ -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 ;
+
+
+