Geez.. I meant to attach it..
Here 'tis.
----- Original Message -----
From: "Brett Handley" <[EMAIL PROTECTED]>
To: <[EMAIL PROTECTED]>
Sent: Thursday, April 12, 2001 12:09 PM
Subject: [REBOL] Directory tools
> Seeing Marcus' console tools post prompted me to post my file-tools.r
script
> I've been working on recently.
>
> In this script I wanted some functions that would recursively work on
> directories whether they are file! or url!.
>
> Also in this script I played with the idea of generating script for
> deferred/custom actions based on reading a directory.
>
> Brett.
>
> ---
> >> browse http://www.codeconscious.com/rebol/
>
> --
> To unsubscribe from this list, please send an email to
> [EMAIL PROTECTED] with "unsubscribe" in the
> subject, without the quotes.
>
-- Attached file included as plaintext by Listar --
-- File: file-tools.r
REBOL [
Title "File Tools"
Author: "Brett Handley"
Purpose: "Define functions that help to manipulate files."
Date: 4-Apr-2001
Comment: {
Here are some File directory productivity functions. The aim is to be
able to use them with urls as well.
In particular:
read-directory
Returns a directory tree as a flat block of file!.
read-directory-tree
Returns a directory tree as a nested block structure.
walk-dir
Will walk a directory tree calling your functions as it goes.
directory-script
Generates a script by walking through a directory.
*** Check the list of supporting scripts you need (below) ***
%highfun.r is available from www.rebol.org (advanced I think)
%mime-types.r is only needed if you want to use the copy-directory function
it is available at www.codeconscious.com/rebol/rebol-scripts.html
}
]
;
; Support scripts
;
if not :use-script [use-script: :do] ; Use-script is my script manager
use-script %highfun.r ; See www.rebol.org to download.
use-script %mime-types.r ; See www.codeconscious.com/rebol/rebol-scripts.html
;
; Functions
;
to-winfile: function [
"Create a windows file specification from the file."
file-spec
][new-file][
new-file: replace/all to-string file-spec "/" "\"
remove head new-file
replace new-file "\" ":\"
new-file
]
folders: func[ series [series!]][
"Filters out the folders in a series."
filter func[x][all [file? x equal? x dirize x]] series
]
files: func[ series [series!]][
"Filters out the files in a series."
filter func[x][all[ file? x not equal? x dirize x]] series
]
assert-is-directory: func[ [catch] dir [file! url!]][
if not equal? dir dirize dir [
throw make error! "Can only accept directories."
]
]
ensure-directory: function[
"Creates the directory if it does not exist."
target-directory
][test-dir][
assert-is-directory target-directory
if not exists? test-dir: target-directory [ make-dir/deep test-dir ]
]
read-directory: function [
"Returns a directory tree as a flat block of file!."
spec [file! url!]
/prefix prefix-spec [file! url!] "Joins the prefix onto the spec but does not
return it in the result."
/include "Includes the directory you specify."
][result read-subdirectory refinements actual-spec][
actual-spec: either prefix [join prefix-spec spec][spec]
either equal? spec dirize spec [
result: copy []
if include [insert tail result spec]
foreach f read actual-spec [
either prefix [
insert tail result read-directory/prefix/include either equal? spec
%./ [f][join spec f] prefix-spec
][
insert tail result read-directory/include either equal? spec %./
[f][join spec f]
]
]
][
result: spec
]
return result
]
read-directory-tree: function [ [catch]
"Returns a directory tree as a nested block structure."
spec [file! url!]
/prefix prefix-spec [file! url!] "Joins the prefix onto the spec but does not
return it in the result."
/include "Includes the specification as the first directory name."
/filter filter-function [any-function!] "Called for each directory and file."
][result dir-list actual-spec][
if not filter [filter-function: func[x][true]]
actual-spec: either prefix [join prefix-spec spec][spec]
either equal? spec dirize spec [
result: copy []
dir-list: read actual-spec
foreach f dir-list [
if filter-function f [
if equal? f dirize f [insert tail result f]
insert/only tail result read-directory-tree/prefix f actual-spec
]
]
][
result: spec
]
if include [ result: reduce [spec result]]
return result
]
directory-tree-walker: context [
emit-dir-path: none
emit-file-path: none
path-stack: none
directory-name: none
file-name: none
push-dir: func [dir] [
insert tail path-stack dir
pre-dir-evt emit-dir-path
]
pop-dir: does [
post-dir-evt emit-dir-path
remove back tail path-stack
]
file-event: func[file][
on-file-evt emit-file-path file
]
pre-dir-evt: none
post-dir-evt: none
on-file-evt: none
=file-tree-structure=: [
any [
[set directory-name file! into [ (push-dir directory-name)
=file-tree-structure= ] (pop-dir) ] |
set file-name file! (file-event file-name)
]
]
set 'walk-dir function [ [catch]
"Walks a directory tree calling your functions as it goes."
directory-spec [block! file! url!] "Directory structure as returned from
read-directory-tree or directory spec."
/paths "Includes the paths."
/relative "Omits the spec from the path."
/include "Includes the specification."
/pre-dir pre-dir-handler [any-function!] "Called at start of directory."
/on-file on-file-handler [any-function!] "Called for each file."
/post-dir post-dir-handler [any-function!] "Called at end of directory."
][directory-data result default-mode parse-result][
either pre-dir [pre-dir-evt: :pre-dir-handler][pre-dir-evt: none]
either on-file [on-file-evt: :on-file-handler][on-file-evt: none]
either post-dir [post-dir-evt: :post-dir-handler][post-dir-evt: none]
if all [
not pre-dir not on-file not post-dir
not relative
any [file? directory-spec url? directory-spec]
][
default-mode: paths: true
pre-dir-evt: on-file-evt: function[x][][
x append result reduce [x info? x]
]
result: copy []
]
either equal? type? directory-spec block! [
directory-data: directory-spec
if relative [throw "Cannot use /relative in this mode."]
if include [throw "Cannot use /include in this mode."]
][
if all [include relative] [throw "Cannot use /include and /relative
together."]
assert-is-directory directory-spec
either include [
relative: true
directory-data: read-directory-tree/include directory-spec
][
directory-data: read-directory-tree directory-spec
]
]
either paths [
either relative [
emit-dir-path: does [
either empty? path-stack [][to-file path-stack]
]
emit-file-path: func[x] [either empty? path-stack [x][join
emit-dir-path x]]
][
emit-dir-path: does [
either empty? path-stack [directory-spec][join directory-spec
to-file path-stack]
]
emit-file-path: func[x] [either empty? path-stack [join directory-spec
x][join emit-dir-path x]]
]
][
emit-dir-path: does [last path-stack]
emit-file-path: func[x] [x]
]
path-stack: copy []
parse-result: parse directory-data =file-tree-structure=
if not default-mode [result: parse-result]
RETURN result
]
]
directory-script: function [
"Generates a script by walking through a directory."
directory-spec [file! url!]
dir-function [word! path!] "A function call to include in the script."
file-function [word! path!] "A function call to include in the script."
/bottom-up "Put directories after their files."
/subtree "Assume we are working on a subtree."
][result dirfunc filefunc walk-result][
dirfunc: func[x][insert tail result reduce [:dir-function x]]
filefunc: func[x][insert tail result reduce [:file-function x]]
result: copy []
if not exists? directory-spec [return result]
either subtree [
either bottom-up [
walk-result: walk-dir/relative/paths/on-file/post-dir directory-spec
:filefunc :dirfunc
][
walk-result: walk-dir/relative/paths/on-file/pre-dir directory-spec
:filefunc :dirfunc
]
][
either bottom-up [
walk-result: walk-dir/include/paths/on-file/post-dir directory-spec
:filefunc :dirfunc
][
walk-result: walk-dir/include/paths/on-file/pre-dir directory-spec
:filefunc :dirfunc
]
]
either walk-result [
return result
][none]
]
copy-directory: function [
"Copies one directory to another."
source-directory [file! url!]
target-directory [file! url!]
/files "Include files"
/script "Return the script instead of carrying out the actions."
][test-dir code copy-dir-func copy-file-func][
assert-is-directory source-directory
assert-is-directory target-directory
copy-dir-func: function[x][test-dir][
if not exists? test-dir: join target-directory x [
make-dir/deep test-dir
]
]
either files [
copy-file-func: func[x][mime-write join target-directory x mime-read join
source-directory x]
][
copy-file-func: func[x][]
]
code: directory-script/subtree source-directory 'copy-dir-func 'copy-file-func
either script [return code][do code]
]
delete-directory: function [
"Deletes everything in a directory tree (in a bottom up fashion.)"
target-directory [file! url!]
/verbose "Displays what is being deleted."
/script "Return the script instead of carrying out the deletes."
][code delete-dir-func delete-file-func][
either verbose [
delete-dir-func: delete-file-func: func[x][print ["Deleting" x] delete x]
][ delete-dir-func: delete-file-func: :delete ]
code: directory-script/bottom-up target-directory 'delete-dir-func
'delete-file-func
either script [return code][do code]
]
--
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the
subject, without the quotes.
