REBOL [ Title: "Html Pretty Print REBOL" Date: 30-Jun-1999 File: %colorize.r Author: "Jeff Kreis" Purpose: {Syntax highlighting for HTML display of REBOL scripts} Organization: "REBOL Technologies" Email: jeff@rebol.com library: [ level: 'advanced platform: none type: none domain: [text-processing markup] tested-under: none support: none license: none see-also: none ] ] find-replace: func [str init fina /spacer /local mark][ mark: str while [mark: find mark init][ insert remove/part mark length? init fina mark: skip mark length? fina ] ] find-end-header: func [point][ braces: 1 point: find/tail point "[" if none? point [ return make error! [user message "No ENDING BRACE of HEADER!!!"] ] while [braces >= 1][ s1: find/tail point "[" s2: find/tail point "]" either all [s1 s2][ either (index? s1) < index? s2 [ braces: braces + 1 point: s1 ][ braces: braces - 1 point: s2 ] ][ any [ all [s1 point: s1 braces: braces + 1] all [s2 point: s2 braces: braces - 1] ] ] ] point ] colorize: func [file /lpoint][ point: entab read file insert point {*_LT_*FONT COLOR="#666699"*_GT_*} point: insert find-end-header point "*_LT_*/FONT*_GT_*" pre-escapes: [ "^^" "*_HT_*" ] foreach [from to] pre-escapes [ find-replace point from to ] lpoint: load copy point if not any [none? lpoint empty? lpoint][meta lpoint] escapes: [ "&" "&" "<" "<" ">" ">" " " "^-" "<" "*_LT_*" ">" "*_GT_*" "^^" "*_HT_*" ] foreach [to from] escapes [ find-replace head point from to ] insert head point copy reform [ file newline
    ]
    append point reduce [newline 
] head point ] soak-white: func [mark][ ws: charset " ^-^/" while [find ws first mark][mark: next mark] mark ] font: func [mark length color][ insert mark color insert skip mark length + length? color {*_LT_*/FONT*_GT_*} ] tag-color: func [col][rejoin [copy {*_LT_*FONT COLOR="} mold col {"*_GT_*}]] meta: func [stuff /e/s1/s2][ if empty? stuff [exit] foreach item load stuff [ ;print ["***" mold :item "*** (" index? point ")"] catch [ if paren? :item [meta append copy [] :item throw] if block? :item [meta :item throw] if path? :item [meta append copy [] first :item throw] if string? :item [ s1: find point rejoin ["{" :item "}"] s2: find point rejoin [{"} :item {"}] if all [none? s1 none? s2][ print ["Couldn't find this string: " :item] throw ] ;print ["S1:" mold either s1 [reform [copy/part s1 20 index? s1]][none] newline newline "S2:" mold ; either s2 [reform [copy/part s2 20 index? s2] ][none] newline newline] point: font back either all [s1 s2][at point min index? s1 index? s2][any [s1 s2]] 3 + length? :item tag-color #336666 throw ] any [ all [ tag? :item point: font find point form :item length? form :item tag-color #996633 ] all [ word? :item value? :item point: font find point form :item length? form :item tag-color #990033 ] all [ any [refinement? :item word? :item not value? :item] point: soak-white point point: skip point length? form :item ] ] ] ] ]