PanedWin.tcl 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: PanedWin.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
  4. #
  5. # PanedWin.tcl --
  6. #
  7. # This file implements the TixPanedWindow widget
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. # Copyright (c) 2004 ActiveState
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16. tixWidgetClass tixPanedWindow {
  17. -classname TixPanedWindow
  18. -superclass tixPrimitive
  19. -method {
  20. add delete forget manage panecget paneconfigure panes setsize
  21. }
  22. -flag {
  23. -command -dynamicgeometry -handleactivebg -handlebg -orient
  24. -orientation -panebd -paneborderwidth -panerelief
  25. -separatoractivebg -separatorbg
  26. }
  27. -static {
  28. -orientation
  29. }
  30. -configspec {
  31. {-command command Command ""}
  32. {-dynamicgeometry dynamicGeometry DynamicGeometry 1 tixVerifyBoolean}
  33. {-handleactivebg handleActiveBg HandleActiveBg #ececec}
  34. {-handlebg handleBg Background #d9d9d9}
  35. {-orientation orientation Orientation vertical}
  36. {-paneborderwidth paneBorderWidth PaneBorderWidth 1}
  37. {-panerelief paneRelief PaneRelief raised}
  38. {-separatoractivebg separatorActiveBg SeparatorActiveBg red}
  39. {-separatorbg separatorBg Background #d9d9d9}
  40. }
  41. -alias {
  42. {-panebd -paneborderwidth}
  43. {-orient -orientation}
  44. }
  45. }
  46. #----------------------------------------------------------------------
  47. # ClassInitialization:
  48. #----------------------------------------------------------------------
  49. proc tixPanedWindow:InitWidgetRec {w} {
  50. upvar #0 $w data
  51. tixChainMethod $w InitWidgetRec
  52. set data(items) ""
  53. set data(nItems) 0
  54. set data(totalsize) 0
  55. set data(movePending) 0
  56. set data(repack) 0
  57. set data(counter) 0
  58. set data(maxReqW) 1
  59. set data(maxReqH) 1
  60. }
  61. proc tixPanedWindow:ConstructWidget {w} {
  62. upvar #0 $w data
  63. tixChainMethod $w ConstructWidget
  64. # Do nothing
  65. }
  66. proc tixPanedWindow:SetBindings {w} {
  67. upvar #0 $w data
  68. tixChainMethod $w SetBindings
  69. bind $w <Configure> [list tixPanedWindow:MasterGeomProc $w ""]
  70. }
  71. #----------------------------------------------------------------------
  72. # ConfigOptions:
  73. #----------------------------------------------------------------------
  74. proc tixPanedWindow:config-handlebg {w arg} {
  75. upvar #0 $w data
  76. for {set i 1} {$i < $data(nItems)} {incr i} {
  77. $data(btn,$i) config -bg $arg
  78. }
  79. }
  80. #----------------------------------------------------------------------
  81. # PublicMethods:
  82. #----------------------------------------------------------------------
  83. # method: add
  84. #
  85. # Adds a new pane into the PanedWindow.
  86. #
  87. # options -size -max -min -allowresize
  88. #
  89. proc tixPanedWindow:add {w name args} {
  90. upvar #0 $w data
  91. if {[winfo exists $w.$name] && !$data($name,forgotten)} {
  92. error "Pane $name is already managed"
  93. }
  94. # Step 1: Parse the options to get the children's size options
  95. # The default values
  96. #
  97. if {[info exists data($name,forgotten)]} {
  98. set option(-size) $data($name,size)
  99. set option(-min) $data($name,min)
  100. set option(-max) $data($name,max)
  101. set option(-allowresize) $data($name,allowresize)
  102. set option(-expand) $data($name,expand)
  103. } else {
  104. set option(-size) 0
  105. set option(-min) 0
  106. set option(-max) 100000
  107. set option(-allowresize) 1
  108. set option(-expand) 0
  109. }
  110. set option(-before) ""
  111. set option(-after) ""
  112. set option(-at) ""
  113. set validOpts {-after -allowresize -at -before -expand -max -min -size}
  114. tixHandleOptions option $validOpts $args
  115. set data($name,size) $option(-size)
  116. set data($name,rsize) $option(-size)
  117. set data($name,min) $option(-min)
  118. set data($name,max) $option(-max)
  119. set data($name,allowresize) $option(-allowresize)
  120. set data($name,expand) $option(-expand)
  121. set data($name,forgotten) 0
  122. if {$data($name,expand) < 0} {
  123. set data($name,expand) 0
  124. }
  125. # Step 2: Add the frame and the separator (if necessary)
  126. #
  127. if {![winfo exist $w.$name]} {
  128. # need to check because the frame may have been "forget'ten"
  129. #
  130. frame $w.$name -bd $data(-paneborderwidth) -relief $data(-panerelief)
  131. }
  132. if {$option(-at) != ""} {
  133. set at [tixGetInt $option(-at)]
  134. if {$at < 0} {
  135. set at 0
  136. }
  137. } elseif {$option(-after) != ""} {
  138. set index [lsearch -exact $data(items) $option(-after)]
  139. if {$index == -1} {
  140. error "Pane $option(-after) doesn't exists"
  141. } else {
  142. set at [incr index]
  143. }
  144. } elseif {$option(-before) != ""} {
  145. set index [lsearch -exact $data(items) $option(-before)]
  146. if {$index == -1} {
  147. error "Pane $option(-before) doesn't exists"
  148. }
  149. set at $index
  150. } else {
  151. set at end
  152. }
  153. set data(items) [linsert $data(items) $at $name]
  154. incr data(nItems)
  155. if {$data(nItems) > 1} {
  156. tixPanedWindow:AddSeparator $w
  157. }
  158. set data(w:$name) $w.$name
  159. # Step 3: Add the new frame. Adjust the window later (do when idle)
  160. #
  161. tixManageGeometry $w.$name [list tixPanedWindow:ClientGeomProc $w]
  162. bind $w.$name <Configure> \
  163. [list tixPanedWindow:ClientGeomProc $w "" $w.$name]
  164. tixPanedWindow:RepackWhenIdle $w
  165. return $w.$name
  166. }
  167. proc tixPanedWindow:manage {w name args} {
  168. upvar #0 $w data
  169. if {![winfo exists $w.$name]} {
  170. error "Pane $name does not exist"
  171. }
  172. if {!$data($name,forgotten)} {
  173. error "Pane $name is already managed"
  174. }
  175. tixMapWindow $data(w:$name)
  176. eval tixPanedWindow:add $w [list $name] $args
  177. }
  178. proc tixPanedWindow:forget {w name} {
  179. upvar #0 $w data
  180. if {![winfo exists $w.$name]} {
  181. error "Pane $name does not exist"
  182. }
  183. if $data($name,forgotten) {
  184. # It has already been forgotten
  185. #
  186. return
  187. }
  188. set items ""
  189. foreach item $data(items) {
  190. if {$item != $name} {
  191. lappend items $item
  192. }
  193. }
  194. set data(items) $items
  195. incr data(nItems) -1
  196. set i $data(nItems)
  197. if {$i > 0} {
  198. destroy $data(btn,$i)
  199. destroy $data(sep,$i)
  200. unset data(btn,$i)
  201. unset data(sep,$i)
  202. }
  203. set data($name,forgotten) 1
  204. tixUnmapWindow $w.$name
  205. tixPanedWindow:RepackWhenIdle $w
  206. }
  207. proc tixPanedWindow:delete {w name} {
  208. upvar #0 $w data
  209. if {![winfo exists $w.$name]} {
  210. error "Pane $name does not exist"
  211. }
  212. if {!$data($name,forgotten)} {
  213. set items ""
  214. foreach item $data(items) {
  215. if {$item != $name} {
  216. lappend items $item
  217. }
  218. }
  219. set data(items) $items
  220. incr data(nItems) -1
  221. set i $data(nItems)
  222. if {$i > 0} {
  223. destroy $data(btn,$i)
  224. destroy $data(sep,$i)
  225. unset data(btn,$i)
  226. unset data(sep,$i)
  227. }
  228. }
  229. unset data($name,allowresize)
  230. unset data($name,expand)
  231. unset data($name,forgotten)
  232. unset data($name,max)
  233. unset data($name,min)
  234. unset data($name,rsize)
  235. unset data($name,size)
  236. unset data(w:$name)
  237. destroy $w.$name
  238. tixPanedWindow:RepackWhenIdle $w
  239. }
  240. proc tixPanedWindow:paneconfigure {w name args} {
  241. upvar #0 $w data
  242. if {![info exists data($name,size)]} {
  243. error "pane \"$name\" does not exist in $w"
  244. }
  245. set len [llength $args]
  246. if {$len == 0} {
  247. set value [$data(w:$name) configure]
  248. lappend value [list -allowresize "" "" "" $data($name,allowresize)]
  249. lappend value [list -expand "" "" "" $data($name,expand)]
  250. lappend value [list -max "" "" "" $data($name,max)]
  251. lappend value [list -min "" "" "" $data($name,min)]
  252. lappend value [list -size "" "" "" $data($name,size)]
  253. return $value
  254. }
  255. if {$len == 1} {
  256. case [lindex $args 0] {
  257. -allowresize {
  258. return [list -allowresize "" "" "" $data($name,allowresize)]
  259. }
  260. -expand {
  261. return [list -expand "" "" "" $data($name,expand)]
  262. }
  263. -min {
  264. return [list -min "" "" "" $data($name,min)]
  265. }
  266. -max {
  267. return [list -max "" "" "" $data($name,max)]
  268. }
  269. -size {
  270. return [list -size "" "" "" $data($name,size)]
  271. }
  272. default {
  273. return [$data(w:$name) configure [lindex $args 0]]
  274. }
  275. }
  276. }
  277. # By default handle each of the options
  278. #
  279. set option(-allowresize) $data($name,allowresize)
  280. set option(-expand) $data($name,expand)
  281. set option(-min) $data($name,min)
  282. set option(-max) $data($name,max)
  283. set option(-size) $data($name,size)
  284. tixHandleOptions -nounknown option {-allowresize -expand -max -min -size} \
  285. $args
  286. #
  287. # the widget options
  288. set new_args ""
  289. foreach {flag value} $args {
  290. case $flag {
  291. {-expand -min -max -allowresize -size} {
  292. }
  293. default {
  294. lappend new_args $flag
  295. lappend new_args $value
  296. }
  297. }
  298. }
  299. if {[llength $new_args] >= 2} {
  300. eval $data(w:$name) configure $new_args
  301. }
  302. #
  303. # The add-on options
  304. set data($name,allowresize) $option(-allowresize)
  305. set data($name,expand) $option(-expand)
  306. set data($name,max) $option(-max)
  307. set data($name,min) $option(-min)
  308. set data($name,rsize) $option(-size)
  309. set data($name,size) $option(-size)
  310. #
  311. # Integrity check
  312. if {$data($name,expand) < 0} {
  313. set data($name,expand) 0
  314. }
  315. if {$data($name,size) < $data($name,min)} {
  316. set data($name,size) $data($name,min)
  317. }
  318. if {$data($name,size) > $data($name,max)} {
  319. set data($name,size) $data($name,max)
  320. }
  321. tixPanedWindow:RepackWhenIdle $w
  322. return ""
  323. }
  324. proc tixPanedWindow:panecget {w name option} {
  325. upvar #0 $w data
  326. if {![info exists data($name,size)]} {
  327. error "pane \"$name\" does not exist in $w"
  328. }
  329. case $option {
  330. {-min -max -allowresize -size} {
  331. regsub \\\- $option "" option
  332. return "$data($name,$option)"
  333. }
  334. default {
  335. return [$data(w:$name) cget $option]
  336. }
  337. }
  338. }
  339. # return the name of all panes
  340. proc tixPanedWindow:panes {w} {
  341. upvar #0 $w data
  342. return $data(items)
  343. }
  344. # set the size of a pane, specifying which direction it should
  345. # grow/shrink
  346. proc tixPanedWindow:setsize {w item size {direction next}} {
  347. upvar #0 $w data
  348. set posn [lsearch $data(items) $item]
  349. if {$posn == -1} {
  350. error "pane \"$item\" does not exist"
  351. }
  352. set diff [expr {$size - $data($item,size)}]
  353. if {$diff == 0} {
  354. return
  355. }
  356. if {$posn == 0 && $direction eq "prev"} {
  357. set direction next
  358. }
  359. if {$posn == $data(nItems)-1 && $direction eq "next"} {
  360. set direction prev
  361. }
  362. if {$data(-orientation) eq "vertical"} {
  363. set rx [winfo rooty $data(w:$item)]
  364. } else {
  365. set rx [winfo rootx $data(w:$item)]
  366. }
  367. if {$direction eq "prev"} {
  368. set rx [expr {$rx - $diff}]
  369. } elseif {$data(-orientation) eq "vertical"} {
  370. set rx [expr {$rx + [winfo height $data(w:$item)] + $diff}]
  371. incr posn
  372. } else {
  373. set rx [expr {$rx + [winfo width $data(w:$item)] + $diff}]
  374. incr posn
  375. }
  376. # Set up the panedwin in a proper state
  377. #
  378. tixPanedWindow:BtnDown $w $posn 1
  379. tixPanedWindow:BtnMove $w $posn $rx 1
  380. tixPanedWindow:BtnUp $w $posn 1
  381. return $data(items)
  382. }
  383. #----------------------------------------------------------------------
  384. # PrivateMethods:
  385. #----------------------------------------------------------------------
  386. proc tixPanedWindow:AddSeparator {w} {
  387. global tcl_platform
  388. upvar #0 $w data
  389. set n [expr {$data(nItems)-1}]
  390. # CYGNUS: On Windows, use relief ridge and a thicker line.
  391. if {$tcl_platform(platform) eq "windows"} then {
  392. set relief "ridge"
  393. set thickness 4
  394. } else {
  395. set relief "sunken"
  396. set thickness 2
  397. }
  398. if {$data(-orientation) eq "vertical"} {
  399. set data(sep,$n) [frame $w.sep$n -relief $relief \
  400. -bd 1 -height $thickness -width 10000 -bg $data(-separatorbg)]
  401. } else {
  402. set data(sep,$n) [frame $w.sep$n -relief $relief \
  403. -bd 1 -width $thickness -height 10000 -bg $data(-separatorbg)]
  404. }
  405. set data(btn,$n) [frame $w.btn$n -relief raised \
  406. -bd 1 -width 9 -height 9 \
  407. -bg $data(-handlebg)]
  408. if {$data(-orientation) eq "vertical"} {
  409. set cursor sb_v_double_arrow
  410. } else {
  411. set cursor sb_h_double_arrow
  412. }
  413. $data(sep,$n) config -cursor $cursor
  414. $data(btn,$n) config -cursor $cursor
  415. foreach wid [list $data(btn,$n) $data(sep,$n)] {
  416. bind $wid \
  417. <ButtonPress-1> [list tixPanedWindow:BtnDown $w $n]
  418. bind $wid \
  419. <ButtonRelease-1> [list tixPanedWindow:BtnUp $w $n]
  420. bind $wid \
  421. <Any-Enter> [list tixPanedWindow:HighlightBtn $w $n]
  422. bind $wid \
  423. <Any-Leave> [list tixPanedWindow:DeHighlightBtn $w $n]
  424. }
  425. if {$data(-orientation) eq "vertical"} {
  426. bind $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %Y]
  427. } else {
  428. bind $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %X]
  429. }
  430. if {$data(-orientation) eq "vertical"} {
  431. # place $data(btn,$n) -relx 0.90 -y [expr "$data(totalsize)-5"]
  432. # place $data(sep,$n) -x 0 -y [expr "$data(totalsize)-1"] -relwidth 1
  433. } else {
  434. # place $data(btn,$n) -rely 0.90 -x [expr "$data(totalsize)-5"]
  435. # place $data(sep,$n) -y 0 -x [expr "$data(totalsize)-1"] -relheight 1
  436. }
  437. }
  438. proc tixPanedWindow:BtnDown {w item {fake 0}} {
  439. upvar #0 $w data
  440. if {$data(-orientation) eq "vertical"} {
  441. set spec -height
  442. } else {
  443. set spec -width
  444. }
  445. if {!$fake} {
  446. for {set i 1} {$i < $data(nItems)} {incr i} {
  447. $data(sep,$i) config -bg $data(-separatoractivebg) $spec 1
  448. }
  449. update idletasks
  450. $data(btn,$item) config -relief sunken
  451. }
  452. tixPanedWindow:GetMotionLimit $w $item $fake
  453. if {!$fake} {
  454. grab -global $data(btn,$item)
  455. }
  456. set data(movePending) 0
  457. }
  458. proc tixPanedWindow:Min2 {a b} {
  459. if {$a < $b} {
  460. return $a
  461. } else {
  462. return $b
  463. }
  464. }
  465. proc tixPanedWindow:GetMotionLimit {w item fake} {
  466. upvar #0 $w data
  467. set curBefore 0
  468. set minBefore 0
  469. set maxBefore 0
  470. for {set i 0} {$i < $item} {incr i} {
  471. set name [lindex $data(items) $i]
  472. incr curBefore $data($name,size)
  473. incr minBefore $data($name,min)
  474. incr maxBefore $data($name,max)
  475. }
  476. set curAfter 0
  477. set minAfter 0
  478. set maxAfter 0
  479. while {$i < $data(nItems)} {
  480. set name [lindex $data(items) $i]
  481. incr curAfter $data($name,size)
  482. incr minAfter $data($name,min)
  483. incr maxAfter $data($name,max)
  484. incr i
  485. }
  486. set beforeToGo [tixPanedWindow:Min2 \
  487. [expr {$curBefore-$minBefore}] \
  488. [expr {$maxAfter-$curAfter}]]
  489. set afterToGo [tixPanedWindow:Min2 \
  490. [expr {$curAfter-$minAfter}] \
  491. [expr {$maxBefore-$curBefore}]]
  492. set data(beforeLimit) [expr {$curBefore-$beforeToGo}]
  493. set data(afterLimit) [expr {$curBefore+$afterToGo}]
  494. set data(curSize) $curBefore
  495. if {!$fake} {
  496. tixPanedWindow:PlotHandles $w 1
  497. }
  498. }
  499. # Compress the motion so that update is quick even on slow machines
  500. #
  501. # rootp = root position (either rootx or rooty)
  502. proc tixPanedWindow:BtnMove {w item rootp {fake 0}} {
  503. upvar #0 $w data
  504. set data(rootp) $rootp
  505. if {$fake} {
  506. tixPanedWindow:BtnMoveCompressed $w $item $fake
  507. } else {
  508. if {$data(movePending) == 0} {
  509. after 2 tixPanedWindow:BtnMoveCompressed $w $item
  510. set data(movePending) 1
  511. }
  512. }
  513. }
  514. proc tixPanedWindow:BtnMoveCompressed {w item {fake 0}} {
  515. if {![winfo exists $w]} {
  516. return
  517. }
  518. upvar #0 $w data
  519. if {$data(-orientation) eq "vertical"} {
  520. set p [expr {$data(rootp)-[winfo rooty $w]}]
  521. } else {
  522. set p [expr {$data(rootp)-[winfo rootx $w]}]
  523. }
  524. if {$p == $data(curSize)} {
  525. set data(movePending) 0
  526. return
  527. }
  528. if {$p < $data(beforeLimit)} {
  529. set p $data(beforeLimit)
  530. }
  531. if {$p >= $data(afterLimit)} {
  532. set p $data(afterLimit)
  533. }
  534. tixPanedWindow:CalculateChange $w $item $p $fake
  535. if {!$fake} {
  536. # Force the redraw to happen
  537. #
  538. update idletasks
  539. }
  540. set data(movePending) 0
  541. }
  542. # Calculate the change in response to mouse motions
  543. #
  544. proc tixPanedWindow:CalculateChange {w item p {fake 0}} {
  545. upvar #0 $w data
  546. if {$p < $data(curSize)} {
  547. tixPanedWindow:MoveBefore $w $item $p
  548. } elseif {$p > $data(curSize)} {
  549. tixPanedWindow:MoveAfter $w $item $p
  550. }
  551. if {!$fake} {
  552. tixPanedWindow:PlotHandles $w 1
  553. }
  554. }
  555. proc tixPanedWindow:MoveBefore {w item p} {
  556. upvar #0 $w data
  557. set n [expr {$data(curSize)-$p}]
  558. # Shrink the frames before
  559. #
  560. set from [expr {$item-1}]
  561. set to 0
  562. tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
  563. # Adjust the frames after
  564. #
  565. set from $item
  566. set to [expr {$data(nItems)-1}]
  567. tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
  568. set data(curSize) $p
  569. }
  570. proc tixPanedWindow:MoveAfter {w item p} {
  571. upvar #0 $w data
  572. set n [expr {$p-$data(curSize)}]
  573. # Shrink the frames after
  574. #
  575. set from $item
  576. set to [expr {$data(nItems)-1}]
  577. tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
  578. # Graw the frame before
  579. #
  580. set from [expr {$item-1}]
  581. set to 0
  582. tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
  583. set data(curSize) $p
  584. }
  585. proc tixPanedWindow:CancleLines {w} {
  586. upvar #0 $w data
  587. if {[info exists data(lines)]} {
  588. foreach line $data(lines) {
  589. set x1 [lindex $line 0]
  590. set y1 [lindex $line 1]
  591. set x2 [lindex $line 2]
  592. set y2 [lindex $line 3]
  593. tixTmpLine $x1 $y1 $x2 $y2 $w
  594. }
  595. catch {unset data(lines)}
  596. }
  597. }
  598. proc tixPanedWindow:PlotHandles {w transient} {
  599. global tcl_platform
  600. upvar #0 $w data
  601. set totalsize 0
  602. set i 0
  603. if {$data(-orientation) eq "vertical"} {
  604. set btnp [expr {[winfo width $w]-13}]
  605. } else {
  606. set h [winfo height $w]
  607. if {$h > 18} {
  608. set btnp 9
  609. } else {
  610. set btnp [expr {$h-9}]
  611. }
  612. }
  613. set firstpane [lindex $data(items) 0]
  614. set totalsize $data($firstpane,size)
  615. if {$transient} {
  616. tixPanedWindow:CancleLines $w
  617. set data(lines) ""
  618. }
  619. for {set i 1} {$i < $data(nItems)} {incr i} {
  620. if {! $transient} {
  621. if {$data(-orientation) eq "vertical"} {
  622. place $data(btn,$i) -x $btnp -y [expr {$totalsize-4}]
  623. place $data(sep,$i) -x 0 -y [expr {$totalsize-1}] -relwidth 1
  624. } else {
  625. place $data(btn,$i) -y $btnp -x [expr {$totalsize-5}]
  626. place $data(sep,$i) -y 0 -x [expr {$totalsize-1}] -relheight 1
  627. }
  628. } else {
  629. if {$data(-orientation) eq "vertical"} {
  630. set x1 [winfo rootx $w]
  631. set x2 [expr {$x1 + [winfo width $w]}]
  632. set y [expr {$totalsize-1+[winfo rooty $w]}]
  633. tixTmpLine $x1 $y $x2 $y $w
  634. lappend data(lines) [list $x1 $y $x2 $y]
  635. } else {
  636. set y1 [winfo rooty $w]
  637. set y2 [expr {$y1 + [winfo height $w]}]
  638. set x [expr {$totalsize-1+[winfo rootx $w]}]
  639. tixTmpLine $x $y1 $x $y2 $w
  640. lappend data(lines) [list $x $y1 $x $y2]
  641. }
  642. }
  643. set name [lindex $data(items) $i]
  644. incr totalsize $data($name,size)
  645. }
  646. }
  647. proc tixPanedWindow:BtnUp {w item {fake 0}} {
  648. upvar #0 $w data
  649. if {!$fake} {
  650. tixPanedWindow:CancleLines $w
  651. }
  652. tixPanedWindow:UpdateSizes $w
  653. if {!$fake} {
  654. $data(btn,$item) config -relief raised
  655. grab release $data(btn,$item)
  656. }
  657. }
  658. proc tixPanedWindow:HighlightBtn {w item} {
  659. upvar #0 $w data
  660. $data(btn,$item) config -background $data(-handleactivebg)
  661. }
  662. proc tixPanedWindow:DeHighlightBtn {w item} {
  663. upvar #0 $w data
  664. $data(btn,$item) config -background $data(-handlebg)
  665. }
  666. #----------------------------------------------------------------------
  667. #
  668. #
  669. # Geometry management routines
  670. #
  671. #
  672. #----------------------------------------------------------------------
  673. # update the sizes of each pane according to the data($name,size) variables
  674. #
  675. proc tixPanedWindow:UpdateSizes {w} {
  676. global tcl_platform
  677. upvar #0 $w data
  678. set data(totalsize) 0
  679. set mw [winfo width $w]
  680. set mh [winfo height $w]
  681. for {set i 0} {$i < $data(nItems)} {incr i} {
  682. set name [lindex $data(items) $i]
  683. if {$data($name,size) > 0} {
  684. if {$data(-orientation) eq "vertical"} {
  685. tixMoveResizeWindow $w.$name 0 $data(totalsize) \
  686. $mw $data($name,size)
  687. tixMapWindow $w.$name
  688. raise $w.$name
  689. } else {
  690. tixMoveResizeWindow $w.$name $data(totalsize) 0 \
  691. $data($name,size) $mh
  692. tixMapWindow $w.$name
  693. raise $w.$name
  694. }
  695. } else {
  696. tixUnmapWindow $w.$name
  697. }
  698. incr data(totalsize) $data($name,size)
  699. }
  700. # Reset the color and width of the separator
  701. #
  702. if {$data(-orientation) eq "vertical"} {
  703. set spec -height
  704. } else {
  705. set spec -width
  706. }
  707. # CYGNUS: On Windows, use a thicker line.
  708. if {$tcl_platform(platform) eq "windows"} then {
  709. set thickness 4
  710. } else {
  711. set thickness 2
  712. }
  713. for {set i 1} {$i < $data(nItems)} {incr i} {
  714. $data(sep,$i) config -bg $data(-separatorbg) $spec $thickness
  715. raise $data(sep,$i)
  716. raise $data(btn,$i)
  717. }
  718. # Invoke the callback command
  719. #
  720. if {$data(-command) != ""} {
  721. set sizes ""
  722. foreach item $data(items) {
  723. lappend sizes $data($item,size)
  724. }
  725. set bind(specs) ""
  726. tixEvalCmdBinding $w $data(-command) bind [list $sizes]
  727. }
  728. }
  729. proc tixPanedWindow:GetNaturalSizes {w} {
  730. upvar #0 $w data
  731. set data(totalsize) 0
  732. set totalreq 0
  733. if {$data(-orientation) eq "vertical"} {
  734. set majorspec height
  735. set minorspec width
  736. } else {
  737. set majorspec width
  738. set minorspec height
  739. }
  740. set minorsize 0
  741. foreach name $data(items) {
  742. if {[winfo manager $w.$name] ne "tixGeometry"} {
  743. error "Geometry management error: pane \"$w.$name\" cannot be managed by \"[winfo manager $w.$name]\"\nhint: delete the line \"[winfo manager $w.$name] $w.$name ...\" from your program"
  744. }
  745. # set the minor size
  746. #
  747. set req_minor [winfo req$minorspec $w.$name]
  748. if {$req_minor > $minorsize} {
  749. set minorsize $req_minor
  750. }
  751. # Check the natural size against the max, min requirements.
  752. # Change the natural size if necessary
  753. #
  754. if {$data($name,size) <= 1} {
  755. set data($name,size) [winfo req$majorspec $w.$name]
  756. }
  757. if {$data($name,size) > 1} {
  758. # If we get zero maybe the widget was not initialized yet ...
  759. #
  760. # %% hazard : what if the window is really 1x1?
  761. #
  762. if {$data($name,size) < $data($name,min)} {
  763. set data($name,size) $data($name,min)
  764. }
  765. if {$data($name,size) > $data($name,max)} {
  766. set data($name,size) $data($name,max)
  767. }
  768. }
  769. # kludge: because a frame always returns req size of {1,1} before
  770. # the packer processes it, we do the following to mark the
  771. # pane as "size unknown"
  772. #
  773. # if {$data($name,size) == 1 && ![winfo ismapped $w.$name]} {
  774. # set data($name,size) 0
  775. # }
  776. # Add up the total size
  777. #
  778. incr data(totalsize) $data($name,size)
  779. # Find out the request size
  780. #
  781. if {$data($name,rsize) == 0} {
  782. set rsize [winfo req$majorspec $w.$name]
  783. } else {
  784. set rsize $data($name,rsize)
  785. }
  786. if {$rsize < $data($name,min)} {
  787. set rsize $data($name,min)
  788. }
  789. if {$rsize > $data($name,max)} {
  790. set rsize $data($name,max)
  791. }
  792. incr totalreq $rsize
  793. }
  794. if {$data(-orientation) eq "vertical"} {
  795. return [list $minorsize $totalreq]
  796. } else {
  797. return [list $totalreq $minorsize]
  798. }
  799. }
  800. #--------------------------------------------------
  801. # Handling resize
  802. #--------------------------------------------------
  803. proc tixPanedWindow:ClientGeomProc {w type client} {
  804. tixPanedWindow:RepackWhenIdle $w
  805. }
  806. #
  807. # This monitor the sizes of the master window
  808. #
  809. proc tixPanedWindow:MasterGeomProc {w master} {
  810. tixPanedWindow:RepackWhenIdle $w
  811. }
  812. proc tixPanedWindow:RepackWhenIdle {w} {
  813. if {![winfo exist $w]} {
  814. return
  815. }
  816. upvar #0 $w data
  817. if {$data(repack) == 0} {
  818. tixWidgetDoWhenIdle tixPanedWindow:Repack $w
  819. set data(repack) 1
  820. }
  821. }
  822. #
  823. # This monitor the sizes of the master window
  824. #
  825. proc tixPanedWindow:Repack {w} {
  826. upvar #0 $w data
  827. # Calculate the desired size of the master
  828. #
  829. set dim [tixPanedWindow:GetNaturalSizes $w]
  830. if {$data(-width) != 0} {
  831. set mreqw $data(-width)
  832. } else {
  833. set mreqw [lindex $dim 0]
  834. }
  835. if {$data(-height) != 0} {
  836. set mreqh $data(-height)
  837. } else {
  838. set mreqh [lindex $dim 1]
  839. }
  840. if !$data(-dynamicgeometry) {
  841. if {$mreqw < $data(maxReqW)} {
  842. set mreqw $data(maxReqW)
  843. }
  844. if {$mreqh < $data(maxReqH)} {
  845. set mreqh $data(maxReqH)
  846. }
  847. set data(maxReqW) $mreqw
  848. set data(maxReqH) $mreqh
  849. }
  850. if {$mreqw != [winfo reqwidth $w] || $mreqh != [winfo reqheight $w] } {
  851. if {![info exists data(counter)]} {
  852. set data(counter) 0
  853. }
  854. if {$data(counter) < 50} {
  855. incr data(counter)
  856. tixGeometryRequest $w $mreqw $mreqh
  857. tixWidgetDoWhenIdle tixPanedWindow:Repack $w
  858. set data(repack) 1
  859. return
  860. }
  861. }
  862. set data(counter) 0
  863. if {$data(nItems) == 0} {
  864. set data(repack) 0
  865. return
  866. }
  867. tixWidgetDoWhenIdle tixPanedWindow:DoRepack $w
  868. }
  869. proc tixPanedWindow:DoRepack {w} {
  870. upvar #0 $w data
  871. if {$data(-orientation) eq "vertical"} {
  872. set newSize [winfo height $w]
  873. } else {
  874. set newSize [winfo width $w]
  875. }
  876. if {$newSize <= 1} {
  877. # Probably this window is too small to see anyway
  878. # %%Kludge: I don't know if this always work.
  879. #
  880. set data(repack) 0
  881. return
  882. }
  883. set totalExp 0
  884. foreach name $data(items) {
  885. set totalExp [expr {$totalExp + $data($name,expand)}]
  886. }
  887. if {$newSize > $data(totalsize)} {
  888. # Grow
  889. #
  890. set toGrow [expr {$newSize-$data(totalsize)}]
  891. set p [llength $data(items)]
  892. foreach name $data(items) {
  893. set toGrow [tixPanedWindow:xGrow $w $name $toGrow $totalExp $p]
  894. if {$toGrow > 0} {
  895. set totalExp [expr {$totalExp-$data($name,expand)}]
  896. incr p -1
  897. } else {
  898. break
  899. }
  900. }
  901. } else {
  902. # Shrink
  903. #
  904. set toShrink [expr {$data(totalsize)-$newSize}]
  905. set usedSize 0
  906. foreach name $data(items) {
  907. set toShrink [tixPanedWindow:xShrink $w $name $toShrink \
  908. $totalExp $newSize $usedSize]
  909. if {$toShrink > 0} {
  910. set totalExp [expr {$totalExp-$data($name,expand)}]
  911. incr usedSize $data($name,size)
  912. } else {
  913. break
  914. }
  915. }
  916. }
  917. tixPanedWindow:UpdateSizes $w
  918. tixPanedWindow:PlotHandles $w 0
  919. set data(repack) 0
  920. }
  921. #--------------------------------------------------
  922. # Shrink and grow items
  923. #--------------------------------------------------
  924. #
  925. # toGrow: how much free area to grow into
  926. # p: == 1 if $name is the last in the list of items
  927. # totalExp: used to calculate the amount of the free area that this
  928. # window can grow into
  929. #
  930. proc tixPanedWindow:xGrow {w name toGrow totalExp p} {
  931. upvar #0 $w data
  932. if {$p == 1} {
  933. set canGrow $toGrow
  934. } else {
  935. if {$totalExp == 0} {
  936. set canGrow 0
  937. } else {
  938. set canGrow [expr {int($toGrow * $data($name,expand) / $totalExp)}]
  939. }
  940. }
  941. if {($canGrow + $data($name,size)) > $data($name,max)} {
  942. set canGrow [expr {$data($name,max) - $data($name,size)}]
  943. }
  944. incr data($name,size) $canGrow
  945. incr toGrow -$canGrow
  946. return $toGrow
  947. }
  948. proc tixPanedWindow:xShrink {w name toShrink totalExp newSize usedSize} {
  949. upvar #0 $w data
  950. if {$totalExp == 0} {
  951. set canShrink 0
  952. } else {
  953. set canShrink [expr {int($toShrink * $data($name,expand) / $totalExp)}]
  954. }
  955. if {$data($name,size) - $canShrink < $data($name,min)} {
  956. set canShrink [expr {$data($name,size) - $data($name,min)}]
  957. }
  958. if {$usedSize + $data($name,size) - $canShrink > $newSize} {
  959. set data($name,size) [expr {$newSize - $usedSize}]
  960. return 0
  961. } else {
  962. incr data($name,size) -$canShrink
  963. incr toShrink -$canShrink
  964. return $toShrink
  965. }
  966. }
  967. #--------------------------------------------------
  968. # Shrink and grow items
  969. #--------------------------------------------------
  970. proc tixPanedWindow:Shrink {w name n} {
  971. upvar #0 $w data
  972. set canShrink [expr {$data($name,size) - $data($name,min)}]
  973. if {$canShrink > $n} {
  974. incr data($name,size) -$n
  975. return 0
  976. } elseif {$canShrink > 0} {
  977. set data($name,size) $data($name,min)
  978. incr n -$canShrink
  979. }
  980. return $n
  981. }
  982. proc tixPanedWindow:Grow {w name n} {
  983. upvar #0 $w data
  984. set canGrow [expr {$data($name,max) - $data($name,size)}]
  985. if {$canGrow > $n} {
  986. incr data($name,size) $n
  987. return 0
  988. } elseif {$canGrow > 0} {
  989. set data($name,size) $data($name,max)
  990. incr n -$canGrow
  991. }
  992. return $n
  993. }
  994. proc tixPanedWindow:Iterate {w from to proc n} {
  995. upvar #0 $w data
  996. if {$from <= $to} {
  997. for {set i $from} {$i <= $to} {incr i} {
  998. set n [$proc $w [lindex $data(items) $i] $n]
  999. if {$n == 0} {
  1000. break
  1001. }
  1002. }
  1003. } else {
  1004. for {set i $from} {$i >= $to} {incr i -1} {
  1005. set n [$proc $w [lindex $data(items) $i] $n]
  1006. if {$n == 0} {
  1007. break
  1008. }
  1009. }
  1010. }
  1011. }