[REBOL] Style R flavour checker ;-)
From: nitsch-lists::netcologne::de at: 8-Jan-2002 13:15
Style R flavour checker ;-)
{
Hi Joel and all,
here is a littel toy to play with style R .
based on carls %clean-script.r .
clip some code, start script, see if you like it :)
-Volker
}
[ REBOL
[ Title: "REBOL Script Cleaner"
Hacked-by: "Volker Nitsch"
one-bug: "inserts empty lines sometimes"
Author: "Carl Sassenrath"
File: %clean-script-style-r.r
based-on: [%clean-script.r "rebol-library"]
Date: 30-May-2000
Email: [carl--rebol--com]
Purpose: {
Cleans REBOL scripts by parsing the REBOL code
and supplying /cut: standard/now: Style R/
indentation and spacing.
}
Note: {
Now it uses Joels Style R. and is hacked. ups.
Well, its a toy.
if Carl sees this by accident and think its more
i have to do some cleanup..
Original Note by Carl:
This script produces STANDARD script indentation and
spacing. No doubt you will want to modify it to use
your own rules. Send your enhancements and I will
consider adding them to the distribution... but keep
this header intact and keep the code clean. No hacks.
}
Category: [script util text 3]
History:
[ "Carl Sassenrath" 1.0.0 27-May-2000 "Original program."
] ]
script-cleaner: make object!
[ out: none ; output text
indent: copy "" ; holds indentation tabs
last-indent: none
tab-spaces: next detab to-string tab
big-letters: charset [#"A" - #"Z"]
emit-line: func []
[ if "" = trim/lines copy last-indent [clear last-indent]
append out newline
]
emit-space: func [pos /local more b2 bracket b1]
[ append out any
[ if newline = last out
[ any
[ if all ;move terminating bracket down
[ find "[(" bracket: first b2: back back tail out
not find "[(" first pos
]
[ clear b2 Emit-line Last-indent: tail out
join next indent [bracket tab]
]
if all
[ find ["^-)^/" "^-]^/"] back back b1: back tail out
find ")]" first pos
any ;starts line with closing bracket?
[ tail? more: next skip last-indent length? indent
find ")]" first more
] ]
[ remove b1 remove last-indent
tab-spaces
]
do
[ last-indent: tail out indent
] ] ]
if find ")]" first pos
[ if any ;starts line with closing bracket?
[ tail? more: skip last-indent 1 + length? indent
find ")]" first more
]
[ if tab = first back more [remove last-indent]
]
either find ")]" last out [tab] [""]
]
if find "[(" last out
[ either any ;starts line with opening bracket?
[ tail? more: skip last-indent length? indent
find "[(" first more
] [tab] [""]
]
" "
] ]
emit: func [from to] [emit-space from Append out copy/part from to]
clean-script: func
[ "Returns new script text with standard spacing."
script "Original Script text"
/local str new blk-rule value more
]
[ out: append clear copy script newline
parse copy script blk-rule:
[ any
[ str:
newline (emit-line) |
#";" [thru newline | to end] new: (emit str new) |
[ #"[" | #"("] (emit str 1 Append indent tab) blk-rule |
[ #"]" | #")"] (remove indent Emit str 1) |
skip
( set [value new] load/next str
either all
[ ;uppercase in line? add sme spaces
not find "^/" last out
any-word? :value find big-letters first str
not any ;starts line with opening bracket?
[ tail? more: skip last-indent length? indent
find "[(" first more
] ]
[ emit-space str
append out join tab-spaces copy/part str new
]
[ emit str new]
) :new
] ]
remove out ; remove first char
if error? error: try
[ either equal? load script load out [return out]
[ alert "formatting error (type 1)! keeping original."
return script
] ]
[ alert "formatting error (type 2)! keeping original."
return script
] ] ]
/main
make script-cleaner
[ view center-face layout [across backdrop [quit]
t1: area para [] 600x400
detab clean-script Read clipboard://
s1: slider 16x400 [scroll-para t1 s1]
] ] ]
