Posted to tcl by egavilan at Tue Feb 19 14:53:50 GMT 2008view raw

  1. #######################################################
  2. # we get three tabs, two created at start and the third a second later. Note the diferences
  3. # of reqheight of each one
  4.  
  5. package require Tk
  6. ttk::setTheme clam
  7.  
  8. proc instance.add { {title ""} } {
  9. global state
  10.  
  11. set tabid $state(NB).[format tab%04d $state(ID)]
  12. set pw [ttk::panedwindow $tabid -orient vertical]
  13.  
  14. # add the upper text
  15. set fup [ttk::frame $pw.up -padding 2]
  16. set txt [text.add $fup]
  17. bind $fup <Configure> "puts \"$fup: \[winfo reqheight $fup\]\""
  18.  
  19. # the lower text
  20. set fdown [ttk::frame $pw.down -padding 2]
  21. #set peer [text.add $fdown $txt]
  22. # we want the lower pane to be hidden
  23. #grid propagate $fdown 0
  24. bind $fdown <Configure> "puts \"$fdown: \[winfo reqheight $fdown\]\""
  25.  
  26. # in the case of resize, the upper pane should take all the space
  27. puts "adding $tabid"
  28. $pw add $fup -weight 1
  29. $pw add $fdown -weight 0
  30.  
  31. # set the title
  32. if {$title eq ""} {set title "Untitled-$state(ID)"}
  33.  
  34. # finally, add the tab to the notebook
  35. $state(NB) add $tabid -text $title
  36.  
  37. bind $tabid <Configure> "puts \"$tabid: \[winfo reqheight $tabid\]\""
  38.  
  39. # init the keys in the array which gather all the data
  40. # in this tab
  41. set state($tabid.txt) $txt
  42. set state($tabid.filename) {}
  43.  
  44. incr state(ID)
  45.  
  46. #######################################################
  47. # if we force the new tab to show, it exposes a {bug|race condition}?
  48. #######################################################
  49. $state(NB) select $tabid
  50. #######################################################
  51.  
  52.  
  53. # bug workaround
  54. event generate $state(NB) <Expose>
  55. }
  56.  
  57. proc text.add { parent {peerof {}} } {
  58. set vs [ttk::scrollbar $parent.vs -orient vertical]
  59. set hs [ttk::scrollbar $parent.hs -orient horizontal]
  60.  
  61. if {$peerof eq ""} {
  62. set t [text $parent.txt \
  63. -yscrollcommand [list $vs set] \
  64. -xscrollcommand [list $hs set]]
  65. } else {
  66. set t [$peerof peer create $parent.txt \
  67. -yscrollcommand [list $vs set] \
  68. -xscrollcommand [list $hs set]]
  69. }
  70.  
  71. $vs configure -command [list $t yview]
  72. $hs configure -command [list $t xview]
  73.  
  74. grid $t $vs -sticky news
  75. grid $hs -sticky news
  76. grid columnconfigure $parent 0 -weight 1
  77. grid rowconfigure $parent 0 -weight 1
  78.  
  79. bind $t <Configure> "puts \"$t: \[winfo reqheight $t\]\""
  80.  
  81. return $t
  82. }
  83.  
  84. proc instance.delete {} {
  85. global state
  86. set tabid [$state(NB) select]
  87.  
  88. # release the data associated with this tab
  89. array unset state $tabid.*
  90.  
  91. # finally, destroy the tab
  92. destroy $tabid
  93.  
  94. }
  95.  
  96. proc build.gui {} {
  97. global state
  98.  
  99. set state(NB) [ttk::notebook .nb]
  100.  
  101. grid $state(NB) -sticky news
  102.  
  103. grid rowconfigure . 0 -weight 1
  104. grid columnconfigure . 0 -weight 1
  105.  
  106. option add *Text.background white
  107. option add *Text.highlightThickness 0
  108. option add *Text.borderWidth 1
  109. option add *Text.selectBorderWidth 0
  110. }
  111.  
  112. proc init {} {
  113. global state
  114. set state(ID) 0
  115. }
  116.  
  117. ############################################################
  118. # App initialization
  119. init
  120. build.gui
  121.  
  122. after 1000 instance.add
  123. instance.add
  124. instance.add
  125.  
  126.  
  127. ###########################################################
  128. # Some general bindings
  129. event add <<New>> <Control-N> <Control-n>
  130. event add <<Close>> <Control-W> <Control-w>
  131.  
  132. bind . <<New>> {instance.add}
  133. bind . <<Close>> {instance.delete}

Comments

Posted by jenglish at Tue Feb 19 15:59:45 GMT 2008 [text] [code]

Cause of the problem: (a) the ttk::panedwindow ignores geometry requests from mapped children; (b) geometry propagation happens at idle-time; but (c) Tk_MapWindow() works immediately. Solution: add [update idletasks] before [$nb select ...] on the newly-created tab. This will allow geometry propagation to finish before mapping the tab.