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

Ah, nice. Mind if I post it to the REBOL.com library?

On Tue, 10 Apr 2001, I wrote: Oops, forgot that tree-init need to be called in 'Tree to reset the rules. Insert it like this (in Tree): any [value? 'nopat nopat: none] tree-init tree-parser filter-contents! (tree-builder dir nr) reduce [ true :pattern :nopat '* '.xvpics*] ()] Btw, you may safely replace '.xvpics* with None if you don't use XV. :-) Marcus ------------------------------------ If you find that life spits on you calm down and pretend it's raining

On Wed, 11 Apr 2001, Carl Sassenrath wrote:

> Ah, nice. Mind if I post it to the REBOL.com library?