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

Some console functions (user_console.r)

 [1/4] from: d4marcus::dtek::chalmers::se at: 10-Apr-2001 19:25

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

 [2/4] from: carl:rebol at: 11-Apr-2001 6:17

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

 [3/4] from: d4marcus:dtek:chalmers:se at: 12-Apr-2001 19:35

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

 [4/4] from: d4marcus:dtek:chalmers:se at: 12-Apr-2001 19:33

On Wed, 11 Apr 2001, Carl Sassenrath wrote:
> Ah, nice. Mind if I post it to the library?
It's not quite finished. Actually there's at least one bug in there. More on that to follow. Anyway, better wait a while. I should probably have a look on some other tree functions first. Besides neither 'tree or 'll runs on their own, they need some of the other include functions. Still, feel free to include it if you think it looks ok already. Marcus ------------------------------------ If you find that life spits on you calm down and pretend it's raining