eglib.tcl 5.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211
  1. ###########################################################
  2. # Name: eglib.tcl
  3. # Author: Daniele Bonini (posta@elettronica.lol)
  4. # Date: 05/12/2023
  5. # Desc: Code library code.
  6. #
  7. # Code Library scaffolding and most of code
  8. # here presented and distributed contain excerpts
  9. # from "Practical Programming in Tcl and Tk, 4th Ed."
  10. # by Brent B. Welch, Ken Jones, Jeffrey Hebbs.
  11. # The original code of these excerpts could be
  12. # borrowed from other sources which the author
  13. # and the contributors to RadXIDE have no
  14. # knowledge about.
  15. #
  16. # License: MIT. Copyrights 5 Mode (Last implementation and adaptations.)
  17. # Copyrights © 2003 Pearson Education Inc. (original excerpts.)
  18. #
  19. ###########################################################
  20. namespace eval eglib {
  21. namespace upvar ::radxide dan dan
  22. set browse(list) [list]
  23. set browse(dir) $dan(WORKDIR)/.examples
  24. set browse(curix) -1
  25. set browse(current) ""
  26. set browse(label) {}
  27. # ____________________ Scrolled_Text ____________________ #
  28. proc Scrolled_Text { f args } {
  29. # Create the text to display the example
  30. frame $f
  31. eval {text $f.text -wrap none \
  32. -xscrollcommand [list $f.xscroll set] \
  33. -yscrollcommand [list $f.yscroll set]} $args
  34. scrollbar $f.xscroll -orient horizontal \
  35. -command [list $f.text xview]
  36. scrollbar $f.yscroll -orient vertical \
  37. -command [list $f.text yview]
  38. grid $f.text $f.yscroll -sticky news
  39. grid $f.xscroll -sticky news
  40. grid rowconfigure $f 0 -weight 1
  41. grid columnconfigure $f 0 -weight 1
  42. return $f.text
  43. }
  44. # ____________________ create ____________________________ #
  45. proc create {wframe} {
  46. # Create the Code Library window
  47. namespace upvar ::radxide dan dan
  48. variable browse
  49. #wm minsize $wframe 30 5
  50. #wm title $wframe "Tcl Example Browser"
  51. # Create a row of buttons along the top
  52. #set f $wframe
  53. set f [frame $wframe.menubar]
  54. pack $f -fill x; #-side left -fill both -expand 1 ;#-fill x
  55. # Create the menubutton and menu
  56. menubutton $f.ex -text Examples -menu $f.ex.m
  57. pack $f.ex -side left
  58. set m [menu $f.ex.m]
  59. button $f.next -text Next -command ::radxide::eglib::Next
  60. button $f.prev -text Previous -command ::radxide::eglib::Previous
  61. # The Run and Reset buttons use EvalEcho that
  62. # is defined by the Tcl shell in Example 24–4 on page 389
  63. button $f.load -text Run -command Run -state disabled
  64. button $f.reset -text Reset -command ::radxide::eglib::Reset
  65. # A label identifies the current example
  66. set browse(label) [set l [label $f.label]]
  67. pack $f.reset $f.load $f.next $f.prev $l -side left
  68. set browse(text) [Scrolled_Text $wframe.body \
  69. -width 40 -height 10\
  70. -setgrid false]
  71. pack $wframe.body -side left -expand 1 -fill both -anchor nw ;#-fill both -expand true
  72. # Look through the example files for their ID number.
  73. catch {
  74. foreach fpath [lsort -dictionary [glob [file join $browse(dir) *]]] {
  75. if [catch {open $fpath} in] {
  76. puts stderr "Cannot open $f: $in"
  77. continue
  78. }
  79. set ex [expr 0]
  80. while {[gets $in line] >= 0} {
  81. #if [regexp {^# Example ([0-9]+)-([0-9]+)} $line x chap ex] {
  82. #regexp {^\/\/\w+} $line x
  83. set fname [file tail $fpath]
  84. set chap [string range $fname [expr [string first \[ $fname]+1] [expr [string last \] $fname]-1]]
  85. if {[string length $chap] <=1} {
  86. set chap "Various"
  87. }
  88. set ex [incr $ex]
  89. lappend examples($chap) $ex
  90. lappend browse(list) $fpath
  91. # Read example title
  92. #gets $in line
  93. set title($chap-$ex) [string trim $line "# "]
  94. #tk_messageBox -title radxide -icon error -message $title($chap-$ex)
  95. set file($chap-$ex) $fpath
  96. close $in
  97. break
  98. #}
  99. }
  100. }
  101. }
  102. # Create two levels of cascaded menus.
  103. # The first level divides up the chapters into chunks.
  104. # The second level has an entry for each example.
  105. option add *Menu.tearOff 0
  106. set limit 8
  107. set c 0; set i 0
  108. foreach chap [lsort [array names examples]] {
  109. $m add cascade -label "$chap..." \
  110. -menu $m.$c
  111. set sub1(chap) [menu $m.$c]
  112. incr c
  113. set i [expr ($i +1) % $limit]
  114. foreach ex [lsort $examples($chap)] {
  115. $sub1(chap) add command -label $title($chap-$ex) \
  116. -command [list ::radxide::eglib::Browse $file($chap-$ex)]
  117. }
  118. }
  119. }
  120. # ___________________ Browse ____________________ #
  121. proc Browse { file } {
  122. # Display a specified file. The label is updated to
  123. # reflect what is displayed, and the text is left
  124. # in a read-only mode after the example is inserted.
  125. variable browse
  126. # update the descriptive label with the filename
  127. #$browse(label) configure -text [set browse(current) [file tail $file]]
  128. set t $browse(text)
  129. $t config -state normal
  130. $t delete 1.0 end
  131. if [catch {open $file} in] {
  132. $t insert end $in
  133. } else {
  134. $t insert end [read $in]
  135. close $in
  136. }
  137. $t config -state disabled
  138. }
  139. # ___________________ Next ____________________ #
  140. proc Next {} {
  141. # Browse the next files in the list
  142. variable browse
  143. if {$browse(curix) < ([llength $browse(list)] - 1)} {
  144. incr browse(curix)
  145. }
  146. ::radxide::eglib::Browse [lindex $browse(list) $browse(curix)]
  147. }
  148. # ___________________ Previous ____________________ #
  149. proc Previous {} {
  150. # Browse the previous files in the list
  151. variable browse
  152. if {$browse(curix) > 0} {
  153. incr browse(curix) -1
  154. }
  155. ::radxide::eglib::Browse [lindex $browse(list) $browse(curix)]
  156. }
  157. # ___________________ Run ____________________ #
  158. proc Run {} {
  159. # Run the example in the shell
  160. variable browse
  161. EvalEcho [list source \
  162. [file join $browse(dir) $browse(current)]]
  163. }
  164. # ___________________ Reset ____________________ #
  165. proc Reset {} {
  166. # Reset the slave in the eval server
  167. variable browse
  168. set t $browse(text)
  169. $t config -state normal
  170. $t delete 1.0 end
  171. $t insert end ""
  172. $t config -state disabled
  173. }
  174. #_______________________
  175. }
  176. # _________________________________ EOF _________________________________ #