Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[REBOL] Re: Directory tools

From: brett:codeconscious at: 12-Apr-2001 13:23

Geez.. I meant to attach it.. Here 'tis. ----- Original Message ----- From: "Brett Handley" <[brett--codeconscious--com]> To: <[rebol-list--rebol--com]> 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 > [rebol-request--rebol--com] 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] ]