Posted to tcl by smlckz at Sat Nov 29 05:35:56 GMT 2025view raw

  1. ## ==== htmlgen.tcl ====
  2. package require Tcl 8.6
  3.  
  4. # Taken from https://wiki.tcl-lang.org/page/Config+file+using+slave+interp
  5. proc parse {body} {
  6. set i [interp create -safe]
  7. try {
  8. $i eval {namespace delete ::}
  9. $i alias unknown apply {args {
  10. upvar 1 a a
  11. lappend a $args
  12. return
  13. }}
  14. set a {}
  15. $i eval $body
  16. return $a
  17. } finally {
  18. interp delete $i
  19. }
  20. }
  21.  
  22. proc html_escape {text} {
  23. return [string map {& &amp; < &lt; > &gt; {"} &quot;} $text]
  24. }
  25.  
  26. proc tag {args} {
  27. set break_lines 0
  28. set recurse 0
  29. set self_closing 0
  30. set open_only 0
  31. set xml 0
  32. set i 0
  33. set n [llength $args]
  34. while {$i < $n} {
  35. set arg [lindex $args $i]
  36. switch -exact -- $arg {
  37. -breaklines {set break_lines 1}
  38. -recurse {set recurse 1}
  39. -selfclosing {set self_closing 1}
  40. -openonly {set open_only 1}
  41. -xml {set xml 1}
  42. -- {incr i; break}
  43. default break
  44. }
  45. incr i
  46. }
  47. set name [lindex $args $i]
  48. set result "<$name"
  49. incr i
  50. while {$i < $n} {
  51. set key [lindex $args $i]
  52. if {![string equal -length 1 $key -]} break
  53. if {[string equal $key --]} {incr i; break}
  54. if {[string equal [string index $key 1] ?]} {
  55. append result { } [string range $key 2 end]
  56. incr i
  57. } else {
  58. append result { } [string range $key 1 end] {="} [html_escape [lindex $args $i+1]] {"}
  59. incr i 2
  60. }
  61. }
  62. if {$self_closing && $xml} {append result {/}}
  63. append result {>}
  64. if {$self_closing || $open_only} {return $result}
  65. set children [lrange $args $i end]
  66. if $recurse {
  67. set children [lmap child $children {process $child $break_lines}]
  68. }
  69. if $break_lines {
  70. append result "\n " [string map {\n "\n "} [join $children \n]] "\n"
  71. } else {
  72. append result [join $children]
  73. }
  74. append result "</$name>"
  75. }
  76.  
  77. set h [interp create -safe]
  78. $h alias unknown tag --
  79. $h alias escape html_escape
  80. foreach {alias name} {` code // em ** strong % h1 %% h2} {
  81. $h alias $alias tag $name
  82. }
  83.  
  84. foreach {flags names} {
  85. {-breaklines -recurse} {ul}
  86. -selfclosing {meta}
  87. -openonly {html}
  88. } {
  89. foreach name $names {
  90. $h alias $name tag {*}$flags -- $name
  91. }
  92. }
  93.  
  94. foreach {name params f} {
  95. comment body {return "<!--[escape $body]-->"}
  96. doctype args {return "<!doctype [join $args]>"}
  97. } {
  98. $h eval [list proc $name $params $f]
  99. }
  100.  
  101. proc process {body {multiline 0}} {
  102. set result [lmap tree [parse $body] {$::h eval $tree}]
  103. if $multiline {join $result \n} else {join $result}
  104. }
  105.  
  106. if {$argc < 1} {
  107. puts "usage: tclsh $argv0 filename"
  108. return
  109. }
  110.  
  111. set f [open [lindex $argv 0]]
  112. set body [read $f]
  113. close $f
  114. puts [process [$h eval [list subst $body]] 1]
  115.  
  116. ## ==== sample input ====
  117. % [` smlckz]s website
  118.  
  119. p Hello, Im [` smlckz]. I like studying. I am interested in mathematics, programming and philosophy.
  120.  
  121. %% Contact
  122.  
  123. ul -class contact {
  124. li Mastodon: [a -rel me -href {https://c.im/@smlckz} @smlckz@c.im]
  125. li IRC: [` smlckz] on [a -href {https://tilde.chat} tilde.chat] and [a -href {https://libera.chat} libera.chat]
  126. }
  127.  
  128. comment {
  129. SPDX-FileCopyrightText: 2025 smlckz
  130. SPDX-License-Identifier: CC-BY-SA-4.0
  131. }
  132. ## ==== sample output ====
  133. <h1><code>smlckz</code>s website</h1>
  134. <p>Hello, Im <code>smlckz</code>. I like studying. I am interested in mathematics, programming and philosophy.</p>
  135. <h2>Contact</h2>
  136. <ul class="contact">
  137. <li>Mastodon: <a rel="me" href="https://c.im/@smlckz">@smlckz@c.im</a></li>
  138. <li>IRC: <code>smlckz</code> on <a href="https://tilde.chat">tilde.chat</a> and <a href="https://libera.chat">libera.chat</a></li>
  139. </ul>
  140. <!--
  141. SPDX-FileCopyrightText: 2025 smlckz
  142. SPDX-License-Identifier: CC-BY-SA-4.0
  143. -->
  144.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week