Paste: file explorer

Author: Manuel
Mode: factor
Date: Sat, 30 Nov 2013 11:07:34
Plain Text | 
USING: accessors colors.constants continuations fry
io.directories io.encodings.ascii io.encodings.string
io.files.info io.files.types io.pathnames kernel math
math.parser models namespaces present prettyprint sequences
splitting ui ui.commands ui.gadgets ui.gadgets.buttons
ui.gadgets.frames ui.gadgets.grids ui.gadgets.packs
ui.gadgets.scrollers ui.gadgets.tables ui.gestures ;

! windows.kernel32 ;

IN: file-explorer

SYMBOL: curdir

! : ascii2char ( num -- letter )
!     B{ } 1sequence ascii decode ;

! returns list of accessible drives
! : list-drives ( -- seq )
!     32 iota
!     [ GetLogicalDrives swap bit? ] filter
!     [ 65 + ascii2char ":" append ] map
!     [ accessible? ] filter ;

: accessible? ( drive -- t/f )
    '[ _ (directory-entries) drop t ] [ drop f ] recover ;

SINGLETON: seq-renderer

! to be done in windows only ?
: normalize-path ( path -- path' )
    "\\" "/" replace ;

M: seq-renderer filled-column drop 0 ;
M: seq-renderer column-titles drop "Path : " curdir get-global append { } 1sequence ;
M: seq-renderer row-columns drop name>> present { } 1sequence ;
M: seq-renderer row-color drop dup directory?
    [ name>> curdir get-global "/" append swap append accessible? [ "blue" ] [ "red" ] if ]
    [ drop "black" ] if named-color ;

M: seq-renderer row-value drop ;

: subfolders? ( dir -- t/f )
    "/\\" split length 1 = not ;
    
: dotdot ( -- dir )
    ".." +directory+ directory-entry boa ;

: set-if-accessible ( path -- )
    dup accessible? [ curdir set-global ] [ drop  ] if ;

: inidir ( -- )
    current-directory get normalize-path dup accessible?
    [ curdir set-global ]
    [ drop home curdir set-global ] if ; ! ??

: dir-below ( dir -- dir )
    "/\\" split but-last "/" join ;

: update-dir ( dir1 -- )
    dup name>> ".." =
    [ drop curdir get-global dir-below set-if-accessible ]
    [ curdir get-global "/" append swap name>> append set-if-accessible ] if ;

: update-if-dir ( dir1 -- )
    dup directory? [ update-dir ] [ drop ] if ;

: curdir-contents ( -- seq )
    curdir get-global dup subfolders?
    [ directory-entries dotdot prefix ]
    [ directory-entries ] if ;

: row-hook ( gadget -- )
    dup selected-row
    [ update-if-dir curdir-contents  ] when swap set-control-value ;

: <file-explorer> ( -- table )
    inidir
    curdir-contents <model>
    seq-renderer
    <table>
        8 >>gap
        COLOR: dark-gray >>column-line-color
        { 500 400 } >>pref-dim
        [ row-hook ] >>hook ;

: select-action ( button -- )
    drop ;

: cancel-action ( button -- )
    close-window ;

: fe-buttons ( -- gadget )
    <shelf>
    "Select" [ select-action ] <border-button> add-gadget
    "Cancel" [ cancel-action ] <border-button> add-gadget ;

: file-explorer ( -- )
    [ 1 2 <frame> { 0 0 } >>filled-cell
      <file-explorer> <scroller>  { 0 0 } grid-add
      fe-buttons { 0 1 } grid-add
      "File Explorer" open-window ] with-ui ;
  
  MAIN: file-explorer

Annotation: Diff to call row-action with select button

Author: Jon
Mode: cvs-commit
Date: Sun, 1 Dec 2013 16:57:12
Plain Text | 
--- /tmp/file-explorer.factor	2013-12-01 17:32:01.808115022 +0100
+++ work/file-explorer/file-explorer.factor	2013-12-01 17:37:16.212103551 +0100
@@ -4,6 +4,7 @@
 math.parser models namespaces present prettyprint sequences
 splitting ui ui.commands ui.gadgets ui.gadgets.buttons
 ui.gadgets.frames ui.gadgets.grids ui.gadgets.packs
+locals
 ui.gadgets.scrollers ui.gadgets.tables ui.gestures ;
 
 ! windows.kernel32 ;
@@ -84,21 +85,22 @@
         { 500 400 } >>pref-dim
         [ row-hook ] >>hook ;
 
-: select-action ( button -- )
-    drop ;
+: select-action ( button file-explorer -- )
+    nip row-action ;
 
 : cancel-action ( button -- )
     close-window ;
 
-: fe-buttons ( -- gadget )
+:: fe-buttons ( file-explorer -- gadget )
     <shelf>
-    "Select" [ select-action ] <border-button> add-gadget
+    "Select" [ file-explorer select-action ] <border-button> add-gadget
     "Cancel" [ cancel-action ] <border-button> add-gadget ;
 
 : file-explorer ( -- )
     [ 1 2 <frame> { 0 0 } >>filled-cell
-      <file-explorer> <scroller>  { 0 0 } grid-add
-      fe-buttons { 0 1 } grid-add
+      <file-explorer>
+          [ <scroller>  { 0 0 } grid-add ]
+          [ fe-buttons { 0 1 } grid-add ] bi 
       "File Explorer" open-window ] with-ui ;
   
   MAIN: file-explorer

New Annotation

Summary:
Author:
Mode:
Body: