Script Library: ml.r

Script Library: 1247 scripts
ml.r

REBOL [
    Title: "ML"
    Date: 3-Jan-2003
    Name: 'ML
    Version: 1.7.0
    File: %ml.r
    Author: "Andrew Martin"
    Needs: [%Build%20Tag.r %Push.r %Pop.r]
    Purpose: {
^-^-ML generates HTML, XHTML, XML, WML and SVG markup
^-^-from Rebol words, paths, tags and blocks.
^-^-}
    eMail: %Al--Bri--xtra--co--nz
    Web: http://valley.150m.com
    library: [
        level: 'advanced 
        platform: none 
        type: none 
        domain: 'web 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

make object! [
    Stack: make block! 10
    push Stack ""
    set 'ML function [
        {ML generates HTML, XHTML, XML, WML and SVG markup
        from Rebol words, paths, tags and blocks.}
        Dialect [block!]
        ] [String Values_Rule Values Value Tag NameSpace] [
        String: copy ""
        Values_Rule: [
            ; Caution! The 'none word below is replaced in the 'parse rule below!
            none [
                set Value any-type! (
                    Tag: next next Tag
                    insert Tag Value
                    Value: none
                    )
                ]
            ; Caution! The 'opt word below is replaced in the 'parse rule below!
            opt [
                set Value [
                    decimal! | file! | block! | string! | char!
                    | money! | time! | issue! | tuple! | date!
                    | email! | pair! | logic! | integer! | url!
                    ]
                ]
            ]
        Values: make block! 10
        parse Dialect [
            any [
                [
                    set Tag tag! (
                        Values_Rule/1: 0    ; Replace 'none word in 'Values_Rule above.
                        Values_Rule/3: either any [ ; Replace 'opt word...
                            #"/" = last Tag ; empty tag.
                            #"?" = first Tag    ; XML tag.
                            #"!" = first Tag    ; DOCTYPE tag.
                            ] [0] [1]
                        )
                    | set Tag [path! | word!] (
                        Tag: to-block get 'Tag
                        ; Replace 'none word in 'Values_Rule above.
                        Values_Rule/1: -1 + length? Tag
                        Values_Rule/3: 'opt ; Replace 'opt word...
                        )
                    ] (Value: none) Values_Rule (
                    Tag: head Tag
                    repend String either none? Value [
                        if not tag? Tag [
                            Tag: Build-Tag Tag
                            ]
                        if all [
                            #"/" <> last Tag
                            #"?" <> first Tag
                            #"!" <> first Tag
                            ] [
                            append Tag " /"
                            ]
                        [Tag newline]
                        ] [
                        [
                            either all [block? Value empty? String] [newline] [""]
                            either tag? Tag [Tag] [
                                Build-Tag head change Tag join first Stack first Tag
                                ]
                            either block? Value [ML Value] [Value]
                            to-tag join #"/" first either tag? Tag [to-block Tag] [Tag]
                            ]
                        ]
                    Values_Rule/1: none
                    )
                | set NameSpace set-word! set Value block! (
                    push Stack probe mold :NameSpace
                    insert tail String ML Value
                    pop Stack
                    )
                | none! ; Ignore 'none values.
                | set Value any-type! (append String Value)
                ]
            end
            ]
        String
        ]
    ]
Notes
email address(es) have been munged to protect them from spam harvesters. If you are a Library member, you can log on and view this script without the munging.
(Al:Bri:xtra:co:nz)