punkshell/scriptlib/tests/html.tcl

proc html_deep {indent tag attrs args} {
    set out ""
    set a ""
    if {[dict size $attrs]} {
        dict for {k v} $attrs {
            append a "$k=\"$v\" "
        }
        set a [string range $a 0 end-1]
        append out "<$tag $a>\n"
    } else {
        append out "<$tag>\n"
    }
        foreach a $args {
            foreach ln [split $a \n] {
                append out "$indent$ln\n"
            }
        }
    append out "</$tag>"
    return $out
}


#html 'block' elements
interp alias {} html     {} html_deep "  " "html" 
interp alias {} head     {} html_deep "  " "head" 
interp alias {} script     {} html_deep "  " "script" 
interp alias {} body     {} html_deep "  " "body" 
interp alias {} div     {} html_deep "  " "div" 
interp alias {} p       {} html_deep "  " "p" 
interp alias {} content {} html_deep "  " "content" 
interp alias {} table   {} html_deep "  " "table" 
interp alias {} tr      {} html_deep "  " "tr" 
interp alias {} th      {} html_deep "  " "th" 
interp alias {} footer  {} html_deep "  " "footer"
#still an html 'block' element - but output horizontally e.g h1-h6
interp alias {} h1     {} html_shallow "  " "h1" 
interp alias {} h2     {} html_shallow "  " "h2" 
interp alias {} h3     {} html_shallow "  " "h3" 
interp alias {} h4     {} html_shallow "  " "h4" 
interp alias {} h5     {} html_shallow "  " "h5" 
interp alias {} h6     {} html_shallow "  " "h6" 


#html "inline" elements
interp alias {} a     {} html_shallow "a" 
interp alias {} em     {} html_shallow "em" 
interp alias {} strong   {} html_shallow  "strong" 
interp alias {} span   {} html_shallow  "span" 


interp alias {} title   {} html_shallow "title" 


proc html_shallow {tag attrs args} {
    set out ""
    set a ""
    if {[dict size $attrs]} {
        dict for {k v} $attrs {
            append a "$k=\"$v\" "
        }
        set a [string range $a 0 end-1]
        append out "<$tag $a>"
    } else {
        append out "<$tag>"
    }    
    foreach a $args {
        append out "$a"
    }
    append out "</$tag>"
    return $out
}
interp alias {} attrs {} dict create

pipeset htmldoc .= list "julian@precisium.com.au" "info@precisium.com"   |email_admin/0,email_info/1> \
    {
        list [title [attrs] "a test"] [script [attrs]]
    } { 
    } |> \
    {
        head [attrs] {*}$data
    } |h> \
    {
    
    
    
    }                                               |> {
    
        div [attrs id div1]
    }                                               |d1> {
    
    
    
    }                                               |> {
        a [attrs href "mailto:$email_admin,$email_info"] "Send Email"               
    }                                               |>  p [attrs]  |>  div [attrs id div-main] |divmain> { 
    
        # we can mix imperative style blocks in 
        set divs [list]
        lappend divs $d1
        
        lappend divs $divmain
        
        lappend divs [div [attrs id div3]]
            
        return $divs
    }                                               |divlist> {




    }                                               |> .= {

        set elements $divlist
            #puts "---->$pipeargs"
            #puts "----[/#.= val $pipeargs]"
            
            footer.= result@1/@@result.= \
            pipeswitch {
                
                pipecase \
                .= val $pipeargs                |argd> \
                1.=         {
                                dict exists $argd -author
                            } {
                
                
                } |> \
                author.=    {
                                dict get $argd -author
                            } {                              
                
                
                } |> \
                            {
                                return "Author: $data"
                            }
                
                pipecase .= val "Author: unknown" |> div [attrs hidden hidden] 
                
            } |> p [attrs] |> footer [attrs]
            
            
        #puts "author: $author"
        #puts "result: $result"
        
        lappend elements $footer
        lappend elements [script [attrs] ""]

        return $elements
    }                                               |> bodydebug.= {
        body [attrs] {*}$data
    }                                               |b> {
        list $h $b
    }                                               |> {
        html [attrs lang en] {*}$data
    }                                               |> {
    
        #args -author name
        return $data
    }                                               <pipeargs| -type optionlist
    

#test version.. doesn't set vars, or go into subpipelines    
proc make_o {pipeline} {
    set oline [list]  ;#o combinator list
    set segment [list]
    set idx 0
    #find first .=
    foreach x $pipeline {
        if {[string match *.=* $x]} {
            set posn [string first .= $x]
            set rhs [string range $x $posn+2 end]
            if {[string length $rhs]} {
               lappend oline [string range $x 0 $posn+1]
               lappend segment $rhs
            } else {
                lappend oline $x
            }
            incr idx
            break
        } else {
            lappend oline $x
        }
        incr idx
    }

    #lappend oline o_of 
    foreach x [lrange $pipeline $idx end] {
        if {[string match "|*>" $x]} {
            #end of segment
            lappend oline o_of [list $segment] $x
            set segment [list]
        } else {
            lappend segment $x
        }
    }
    if {[llength $segment]} {
        lappend oline o_of [list $segment]
    }
    puts stdout "-- oline :$oline"
    return $oline
}

proc make_funcl {pipeline} {
    set o [make_o $pipeline]
    set funcl [$o]
}

proc make_script {pipeline} {
    funcl::funcl_script [make_funcl $pipeline]
}

proc run_pipe {pipeline} {
    funcl::funcl_script_test [make_script $pipeline]
}