Ah, nice. Mind if I post it to the REBOL.com library?
> -----Original Message-----
> From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]]On Behalf Of
> Marcus Petersson
> Sent: Tuesday, April 10, 2001 10:26 AM
> To: [EMAIL PROTECTED]
> Subject: [REBOL] Some console functions (user_console.r)
>
>
> Here's some various functions included in my startup, that perhaps someone
> else will find useful. A few of them are modified versions of functions
> found in other people's scripts, but some are written from scratch by me.
>
> You may find that 'tree-builder and 'recurse share some ideas. However,
> 'tree-builder builds the entire directory tree down to a level (if given),
> using 'filter-contents to apply pattern-matching. Whereas 'recurse checks
> for matches directly, and only include files at the end of the pattern
> (or the contents if it's a dir, same behaviour as ls -l in Unix).
>
> See 'tree and 'll respectivly for examples of 'tree-builder and 'recurse.
> Both use 'tree-parser, 'tree with default actions, 'll with custom ones.
>
> Oops, almost forgot examples for ll and tree:
>
> ll Doc*/*/*.html
> Tree/match %Docs *.html
>
>
> REBOL [
> Title: "User Console Functions"
> Date: 09-Apr-2001
> Author: "Marcus Petersson"
> ]
>
> Cls: func ["Clear screen"] [prin "^(page)"]
>
> ;----------------------------------------------------------------
>
> history-size: 40
>
> history: func [
> "Show history."
> nr [any-type!] "Any other arg but an integer is ignored" /local hist
> ] [
> if not all [value? 'nr integer? nr] [nr: history-size]
> hist: copy/part system/console/history nr
> foreach empty (head reverse hist) [print empty]]
>
> ;----------------------------------------------------------------
>
> echo-char: func [
> "Repeats the characters you press. End with Ctrl-D."
> /local cons char
> ] [
> cons: open/binary [scheme: 'console]
> while [
> wait cons
> char: to-char first cons
> char <> #"^D"
> ] [
> print [mold char "Value:" to-integer char]
> ]
> close cons
> ]
>
> ;----------------------------------------------------------------
>
> ; shell aliases
> ls: :list-dir
> rm: :delete
> mv: :rename
> wd: pwd: :what-dir
>
> docstring: func [
> "Returns the documentation string (if any) of a function"
> 'f [any-word!]] [f: first third get to-lit-word f all [string? f f]]
>
> md: func compose [(docstring make-dir) path [file! url!]] [
> make-dir/deep to-file path]
>
> dir-previous: reduce [what-dir]
> if not value? 'dir-home [dir-home: system/options/home]
>
> cd: func compose [(docstring change-dir)
> dir [file! string! word! unset!] "New directory path (home if unset)"
> ] [
> dir-previous: union reduce [what-dir] dir-previous
> change-dir either value? 'dir [to-file dir] [dir-home]]
>
> p: func [
> "Goto previous dir."
> nr [any-type!] "Any other arg but an integer is ignored"
> ] [
> if not all [value? 'nr integer? nr (nr <= length?
> dir-previous)] [nr: 1]
> cd dir-previous/:nr]
>
> ..: func [] [cd %..]
>
> ;----------------------------------------------------------------
>
> timer: function ["Requires Core 2.4" funcs [block!]] [start] [
> start: now/time/precise do funcs now/time/precise - start]
>
> ;----------------------------------------------------------------
>
> ;; Example: print pad/with "Not Unix" -2000 "GNU's "
> ;; pad/with 33 33 33
> pad: func ["Pad some value."
> value "Value to pad"
> length [integer!] {Final length of string.
> positive => pad after value (left justify)
> negative => pad before value (right justify)}
> /with char [char! string! integer!] "Character to pad with"
> /local l2
> ] [
> any [string? char char: either with [to-string to-char char] [" "]]
> with: negative? length ; reusing 'with
> value: copy/part to-string value length: abs length
> either positive? l2: length - length? value [
> head insert do either with [:tail] [:head] (copy/part (to-string
> array/initial 1 + to-integer (length / length? char)char)
> l2) value] [value]
> ]
>
> ;----------------------------------------------------------------
>
> wildcards: function [
> "Translates ? and * wildcard expression to REBOL parse rule."
> 'pattern] [fpt ar rule p question star] [
> rule: copy []
> ar: func [p] [any [None? p append rule p]]
> fpt: func [val /local bt] [all [not empty? bt: back tail rule
> ('thru = bt/1) insert remove back tail rule val]]
> question: [copy p to "?" (ar p fpt [] ar [skip]) skip]
> star: [copy p to "*" (ar p fpt [] ar [thru]) skip]
> parse to-string pattern [any [star | question] copy p to end (ar p)]
> fpt [to end] rule
> ]
>
>
> filter-contents: func [
> {Filters a multi-level block of to-stringable series or words
> through either ?*-style patterns or REBOL parse rules.}
> block [block!] "Block to filter"
> 'pattern "Pattern to match"
> /except "Except..." 'nopat "Pattern to not match"
> /tree "To filter a dir-tree-block"
> 'dirpattern "Dir pattern to match"
> 'dirnopat [any-type!] "Dir pattern to not match"
> ] [
> any [dirpattern dirpattern: '*]
> any [value? 'dirnopat dirnopat: None]
> filter-contents! block reduce [tree :pattern :nopat
> :dirpattern :dirnopat]
> ]
>
> filter-contents!: function [
> "Main function of filter-contents"
> block [block!] "Block to filter"
> _p [block!] {Five items: 1. Are we matching a dir-tree-block? /
> 2. Pattern to match / 3. not match /
> 4. Dir pattern to match / 5. not match}
> ] [
> matching filter nr
> ] [
> nr: next _p
> forall nr [any [block? nr/1 nr/1: wildcards nr/1]]
> nr: either _p/1 [2] [1]
> matching: copy/deep block
> filter: function [f] [parsef1 match-dir] [
> parsef1: func [_pat] [parse/case to-string f/1 _pat]
> match-dir: does [either all [_p/1
> any [not parsef1 _p/4 parsef1 _p/5]] [
> remove/part f 2] [filter f/:nr f: skip f nr]]
> until [either block? f/:nr [match-dir] [
> either any [not parsef1 _p/2 parsef1 _p/3] [
> remove f] [f: next f]] empty? f]]
> filter matching
> head matching
> ]
>
> ;----------------------------------------------------------------
>
> Tree!: make object! [
>
> set 'tree-builder function [
> "Builds a directory tree, returns a nested block"
> dir [file!] level [integer! none!]] [path build] [
> build: function [dir] [
> files result
> ] [
> result: copy []
> if any [None? level level > 0] [
> files: sort/case read path
> foreach file files [
> either dir? join path file [
> append result file
> append path file
> all [level level: level - 1]
> append/only result build file
> all [level level: level + 1]
> clear find/last path file
> ] [
> append result file]]]
> result]
> any [value? 'level level: None]
> either dir? dir [path: dirize dir
> append/only reduce [path] build path] [
> reduce [dir]]
> ]
>
> ; variables that tree-parser use
> stack!: make object! [
> stack: make block! 32
> push: func [item] [insert/only stack item]
> pop: func [/local item] [item: pick stack 1 remove stack item]
> depth: does [length? stack]
> see1: does [pick stack 1]
> check: does [probe stack]
> ]
> intstack!: make stack! [
> inc1: does [stack/1: stack/1 + 1]
> dec1: does [stack/1: stack/1 - 1]
> dec2: does [stack/1: stack/1 - 2]
> indent: func [_branch _space _node _end /local result] [
> either depth < 2 [[]] [
> result: copy either (0 < stack/1) [_node] [_end]
> foreach int copy/part at stack 2 (length? stack) - 2 [
> insert result either (0 < int) [_branch] [_space]]
> result]]
> default-indent: does [indent "| " " " "|-- " "`-- "]
> ]
>
> path: branch: block: node: counter: None
> branchaction-default: [print rejoin ["dir: "
> counter/default-indent branch]]
> nodeaction-default: [print rejoin ["file: "
> counter/default-indent node]]
> branchaction: branchaction-default
> nodeaction: nodeaction-default
>
> type-branch: [file! | string!]
> type-node: type-branch
>
> set 'tree-count-items func [b [block!] /local c] [
> c: length? b parse b [any [[block! (c: c - 1)] | skip]] c]
>
> branchrule: [set branch type-branch set block block!
> (counter/dec2
> path: either all [path path <> %./] [join path
> branch] [branch]
> do branchaction
> counter/push length? block
> parse block rule
> counter/pop
> path: first split-path path)]
> noderule: [set node type-node
> (counter/dec1
> do nodeaction)]
> rule: [any [branchrule | noderule]]
>
> set 'tree-init func [/branch action1 /node action2] [
> branchaction: either branch [bind action1 in self 'self]
> [branchaction-default]
> nodeaction: either node [bind action2 in self 'self]
> [nodeaction-default] ()]
>
> set 'tree-parser func [treeblock [block!]] [
> ;any [block? pick treeblock 2 path: %./]
> counter: make intstack! []
> counter/push length? treeblock
> parse treeblock rule]
>
> set 'Tree func ["Print directory tree"
> dir [file! unset!] "Directory to list"
> /level nr [integer!] "Levels to recurse" ()
> /match 'pattern [any-word! string! file!] "Pattern to match"
> 'nopat [any-word! string! file! unset!] "Optional pattern
> to not match"
> ] [
> any [value? 'dir dir: %.]
> any [pattern pattern: '*]
> any [value? 'nopat nopat: none]
> tree-parser filter-contents! (tree-builder dir nr) reduce [
> true :pattern :nopat '* '.xvpics*] ()]
> ]
>
> ;----------------------------------------------------------------
>
> recurse: function ['pattern] [dir dots] [
> pattern: either any [any-word? :pattern path? :pattern] [
> to-block :pattern] [parse :pattern "/"]
> parse pattern [copy dots [any ['.. | ".."]] copy pattern to end]
> any [pattern pattern: copy []]
> dir: either dots [to-file dots] [%.]
> forall pattern [pattern/1: wildcards pattern/1]
> recurse! (clean-path dirize dir) head pattern
> ]
>
> recurse!: function [dir [file!] pattern [block!]] [
> match-file result files block dirs dirnext
> ] [
> match-file: func [file] [
> remove back tail file: dirize to-string file
> parse/case file pattern/1]
> result: copy []
> dirs: copy []
> files: sort/case read dir
>
> foreach file files [
> if match-file file [
> dirnext: to-file reduce [dir file]
> either all [dir? dirnext not empty? pattern] [append
> dirs dirnext] [
> if empty? next pattern [append result file]]]]
> foreach dir dirs [
> if not empty? block: recurse! dir next pattern [
> append result last split-path dir
> append/only result block]]
> result
> ]
>
> ll: function [
> "Display a directory listing"
> 'pattern [any-type!] "Optional pattern for selective list.
> Use wildcards * and ?"
> /silent
> ][
> branchact nodeact filepath file-size file-mod file-time
> file-date buffer
> ][
> branchact: [if not block? block/2 [
> append buffer rejoin ["^/" path " (" tree-count-items
> block " files):^/"]]]
> nodeact: [filepath: either path [to-file reduce [path node]] [node]
> file-size: pad (either dir? filepath [length? read
> filepath] [size? filepath]) -8
> if file-mod: modified? filepath [
> parse (to-string file-mod/time) [copy file-time [thru
> ":" to ":"]
> (file-time: pad file-time -5)]
> file-date: rejoin [pad file-mod/date -11]]
> append buffer rejoin [file-size " " file-date " "
> file-time " " node "^/"]]
>
> any [value? 'pattern pattern: ""]
> buffer: make string! 1000
> tree-init/branch/node branchact nodeact
> tree-parser recurse :pattern
> either silent [buffer] [prin buffer]
> ]
>
> () ; end of script
>
> Marcus
>
> ------------------------------------
> If you find that life spits on you
> calm down and pretend it's raining
>
>
>
> --
> To unsubscribe from this list, please send an email to
> [EMAIL PROTECTED] with "unsubscribe" in the
> subject, without the quotes.
>
>
--
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the
subject, without the quotes.
