notebook.tcl 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867
  1. # ------------------------------------------------------------------------------
  2. # notebook.tcl
  3. # This file is part of Unifix BWidget Toolkit
  4. # $Id$
  5. # ------------------------------------------------------------------------------
  6. # Index of commands:
  7. # - NoteBook::create
  8. # - NoteBook::configure
  9. # - NoteBook::cget
  10. # - NoteBook::compute_size
  11. # - NoteBook::insert
  12. # - NoteBook::delete
  13. # - NoteBook::itemconfigure
  14. # - NoteBook::itemcget
  15. # - NoteBook::bindtabs
  16. # - NoteBook::raise
  17. # - NoteBook::see
  18. # - NoteBook::page
  19. # - NoteBook::pages
  20. # - NoteBook::index
  21. # - NoteBook::getframe
  22. # - NoteBook::_test_page
  23. # - NoteBook::_itemconfigure
  24. # - NoteBook::_compute_width
  25. # - NoteBook::_get_x_page
  26. # - NoteBook::_xview
  27. # - NoteBook::_highlight
  28. # - NoteBook::_select
  29. # - NoteBook::_redraw
  30. # - NoteBook::_draw_page
  31. # - NoteBook::_draw_arrows
  32. # - NoteBook::_draw_area
  33. # - NoteBook::_resize
  34. # - NoteBook::_realize
  35. # ------------------------------------------------------------------------------
  36. namespace eval NoteBook {
  37. ArrowButton::use
  38. namespace eval Page {
  39. Widget::declare NoteBook::Page {
  40. {-state Enum normal 0 {normal disabled}}
  41. {-createcmd String "" 0}
  42. {-raisecmd String "" 0}
  43. {-leavecmd String "" 0}
  44. {-image TkResource "" 0 label}
  45. {-text String "" 0}
  46. }
  47. }
  48. Widget::declare NoteBook {
  49. {-foreground TkResource "" 0 button}
  50. {-background TkResource "" 0 button}
  51. {-activebackground TkResource "" 0 button}
  52. {-activeforeground TkResource "" 0 button}
  53. {-disabledforeground TkResource "" 0 button}
  54. {-font TkResource "" 0 button}
  55. {-side Enum top 1 {top bottom}}
  56. {-homogeneous Boolean 0 0}
  57. {-borderwidth Int 1 0 {=1 =2}}
  58. {-width Int 0 0 {=0 ""}}
  59. {-height Int 0 0 {=0 ""}}
  60. {-repeatdelay BwResource "" 0 ArrowButton}
  61. {-repeatinterval BwResource "" 0 ArrowButton}
  62. {-fg Synonym -foreground}
  63. {-bg Synonym -background}
  64. {-bd Synonym -borderwidth}
  65. }
  66. Widget::addmap NoteBook "" :cmd {-background {}}
  67. Widget::addmap NoteBook ArrowButton .fg \
  68. {-foreground {} -background {} -activeforeground {} -activebackground {} \
  69. -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
  70. Widget::addmap NoteBook ArrowButton .fd \
  71. {-foreground {} -background {} -activeforeground {} -activebackground {} \
  72. -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
  73. variable _warrow 12
  74. proc ::NoteBook { path args } { return [eval NoteBook::create $path $args] }
  75. proc use {} {}
  76. }
  77. # ------------------------------------------------------------------------------
  78. # Command NoteBook::create
  79. # ------------------------------------------------------------------------------
  80. proc NoteBook::create { path args } {
  81. variable $path
  82. upvar 0 $path data
  83. Widget::init NoteBook $path $args
  84. set data(base) 0
  85. set data(select) ""
  86. set data(pages) {}
  87. set data(pages) {}
  88. set data(cpt) 0
  89. set data(realized) 0
  90. set data(wpage) 0
  91. set data(hpage) [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
  92. set bg [Widget::getoption $path -background]
  93. # --- creation du canvas -----------------------------------------------------------------
  94. set w [expr {[Widget::getoption $path -width]+4}]
  95. set h [expr {[Widget::getoption $path -height]+$data(hpage)+4}]
  96. canvas $path -relief flat -bd 0 -highlightthickness 0 -bg $bg -width $w -height $h
  97. # --- creation des arrow -----------------------------------------------------------------
  98. eval ArrowButton::create $path.fg [Widget::subcget $path .fg] \
  99. -highlightthickness 0 \
  100. -type button -dir left \
  101. -armcommand [list "NoteBook::_xview $path -1"]
  102. eval ArrowButton::create $path.fd [Widget::subcget $path .fd] \
  103. -highlightthickness 0 \
  104. -type button -dir right \
  105. -armcommand [list "NoteBook::_xview $path 1"]
  106. set col [BWidget::get3dcolor $path $bg]
  107. set data(dbg) [lindex $col 0]
  108. set data(lbg) [lindex $col 1]
  109. bind $path <Configure> "NoteBook::_realize $path"
  110. bind $path <Destroy> "NoteBook::_destroy $path"
  111. rename $path ::$path:cmd
  112. proc ::$path { cmd args } "return \[eval NoteBook::\$cmd $path \$args\]"
  113. return $path
  114. }
  115. # ------------------------------------------------------------------------------
  116. # Command NoteBook::configure
  117. # ------------------------------------------------------------------------------
  118. proc NoteBook::configure { path args } {
  119. variable $path
  120. upvar 0 $path data
  121. set res [Widget::configure $path $args]
  122. set redraw 0
  123. if { [set chf [Widget::hasChanged $path -font font]] ||
  124. [Widget::hasChanged $path -homogeneous foo] } {
  125. if { $chf } {
  126. set data(hpage) [expr {[font metrics $font -linespace] + 6}]
  127. }
  128. _compute_width $path
  129. set redraw 1
  130. }
  131. if { [Widget::hasChanged $path -background bg] } {
  132. set col [BWidget::get3dcolor $path $bg]
  133. set data(dbg) [lindex $col 0]
  134. set data(lbg) [lindex $col 1]
  135. set redraw 1
  136. }
  137. if { [Widget::hasChanged $path -foreground fg] ||
  138. [Widget::hasChanged $path -borderwidth bd] } {
  139. set redraw 1
  140. }
  141. set wc [Widget::hasChanged $path -width w]
  142. set hc [Widget::hasChanged $path -height h]
  143. if { $wc || $hc } {
  144. $path:cmd configure -width [expr {$w+4}] -height [expr {$h + $data(hpage)+4}]
  145. } elseif { $redraw } {
  146. _redraw $path
  147. }
  148. return $res
  149. }
  150. # ------------------------------------------------------------------------------
  151. # Command NoteBook::cget
  152. # ------------------------------------------------------------------------------
  153. proc NoteBook::cget { path option } {
  154. return [Widget::cget $path $option]
  155. }
  156. # ------------------------------------------------------------------------------
  157. # Command NoteBook::compute_size
  158. # ------------------------------------------------------------------------------
  159. proc NoteBook::compute_size { path } {
  160. variable $path
  161. upvar 0 $path data
  162. set wmax 0
  163. set hmax 0
  164. update idletasks
  165. foreach page $data(pages) {
  166. set w [winfo reqwidth $path.f$page]
  167. set h [winfo reqheight $path.f$page]
  168. set wmax [expr {$w>$wmax ? $w : $wmax}]
  169. set hmax [expr {$h>$hmax ? $h : $hmax}]
  170. }
  171. configure $path -width $wmax -height $hmax
  172. }
  173. # ------------------------------------------------------------------------------
  174. # Command NoteBook::insert
  175. # ------------------------------------------------------------------------------
  176. proc NoteBook::insert { path index page args } {
  177. variable $path
  178. upvar 0 $path data
  179. if { [lsearch $data(pages) $page] != -1 } {
  180. return -code error "page \"$page\" already exists"
  181. }
  182. Widget::init NoteBook::Page $path.f$page $args
  183. set data(pages) [linsert $data(pages) $index $page]
  184. if { ![winfo exists $path.f$page] } {
  185. frame $path.f$page \
  186. -relief flat -background [Widget::getoption $path -background] -borderwidth 10
  187. set data($page,realized) 0
  188. }
  189. _compute_width $path
  190. _draw_page $path $page 1
  191. _redraw $path
  192. return $path.f$page
  193. }
  194. # ------------------------------------------------------------------------------
  195. # Command NoteBook::delete
  196. # ------------------------------------------------------------------------------
  197. proc NoteBook::delete { path page {destroyframe 1} } {
  198. variable $path
  199. upvar 0 $path data
  200. set pos [_test_page $path $page]
  201. set data(pages) [lreplace $data(pages) $pos $pos]
  202. _compute_width $path
  203. $path:cmd delete p:$page
  204. if { $data(select) == $page } {
  205. set data(select) ""
  206. }
  207. if { $pos < $data(base) } {
  208. incr data(base) -1
  209. }
  210. if { $destroyframe } {
  211. destroy $path.f$page
  212. }
  213. _redraw $path
  214. }
  215. # ------------------------------------------------------------------------------
  216. # Command NoteBook::itemconfigure
  217. # ------------------------------------------------------------------------------
  218. proc NoteBook::itemconfigure { path page args } {
  219. _test_page $path $page
  220. set res [_itemconfigure $path $page $args]
  221. _redraw $path
  222. return $res
  223. }
  224. # ------------------------------------------------------------------------------
  225. # Command NoteBook::itemcget
  226. # ------------------------------------------------------------------------------
  227. proc NoteBook::itemcget { path page option } {
  228. _test_page $path $page
  229. return [Widget::cget $path.f$page $option]
  230. }
  231. # ------------------------------------------------------------------------------
  232. # Command NoteBook::bindtabs
  233. # ------------------------------------------------------------------------------
  234. proc NoteBook::bindtabs { path event script } {
  235. if { $script != "" } {
  236. $path:cmd bind "page" $event \
  237. "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
  238. } else {
  239. $path:cmd bind "page" $event {}
  240. }
  241. }
  242. # ------------------------------------------------------------------------------
  243. # Command NoteBook::move
  244. # ------------------------------------------------------------------------------
  245. proc NoteBook::move { path page index } {
  246. variable $path
  247. upvar 0 $path data
  248. set pos [_test_page $path $page]
  249. set data(pages) [linsert [lreplace $data(pages) $pos $pos] $index $page]
  250. _redraw $path
  251. }
  252. # ------------------------------------------------------------------------------
  253. # Command NoteBook::raise
  254. # ------------------------------------------------------------------------------
  255. proc NoteBook::raise { path {page ""} } {
  256. variable $path
  257. upvar 0 $path data
  258. if { $page != "" } {
  259. _test_page $path $page
  260. _select $path $page
  261. }
  262. return $data(select)
  263. }
  264. # ------------------------------------------------------------------------------
  265. # Command NoteBook::see
  266. # ------------------------------------------------------------------------------
  267. proc NoteBook::see { path page } {
  268. variable $path
  269. upvar 0 $path data
  270. set pos [_test_page $path $page]
  271. if { $pos < $data(base) } {
  272. set data(base) $pos
  273. _redraw $path
  274. } else {
  275. set w [expr {[winfo width $path]-1}]
  276. set fpage [expr {[_get_x_page $path $pos] + $data($page,width) + 6}]
  277. set idx $data(base)
  278. while { $idx < $pos && $fpage > $w } {
  279. set fpage [expr {$fpage - $data([lindex $data(pages) $idx],width)}]
  280. incr idx
  281. }
  282. if { $idx != $data(base) } {
  283. set data(base) $idx
  284. _redraw $path
  285. }
  286. }
  287. }
  288. # ------------------------------------------------------------------------------
  289. # Command NoteBook::page
  290. # ------------------------------------------------------------------------------
  291. proc NoteBook::page { path first {last ""} } {
  292. variable $path
  293. upvar 0 $path data
  294. if { $last == "" } {
  295. return [lindex $data(pages) $first]
  296. } else {
  297. return [lrange $data(pages) $first $last]
  298. }
  299. }
  300. # ------------------------------------------------------------------------------
  301. # Command NoteBook::pages
  302. # ------------------------------------------------------------------------------
  303. proc NoteBook::pages { path {first ""} {last ""}} {
  304. variable $path
  305. upvar 0 $path data
  306. if { ![string length $first] } {
  307. return $data(pages)
  308. }
  309. if { ![string length $last] } {
  310. return [lindex $data(pages) $first]
  311. } else {
  312. return [lrange $data(pages) $first $last]
  313. }
  314. }
  315. # ------------------------------------------------------------------------------
  316. # Command NoteBook::index
  317. # ------------------------------------------------------------------------------
  318. proc NoteBook::index { path page } {
  319. variable $path
  320. upvar 0 $path data
  321. return [lsearch $data(pages) $page]
  322. }
  323. # ------------------------------------------------------------------------------
  324. # Command NoteBook::_destroy
  325. # ------------------------------------------------------------------------------
  326. proc NoteBook::_destroy { path } {
  327. variable $path
  328. upvar 0 $path data
  329. foreach page $data(pages) {
  330. Widget::destroy $path.f$page
  331. }
  332. Widget::destroy $path
  333. unset data
  334. rename $path {}
  335. }
  336. # ------------------------------------------------------------------------------
  337. # Command NoteBook::getframe
  338. # ------------------------------------------------------------------------------
  339. proc NoteBook::getframe { path page } {
  340. return $path.f$page
  341. }
  342. # ------------------------------------------------------------------------------
  343. # Command NoteBook::_test_page
  344. # ------------------------------------------------------------------------------
  345. proc NoteBook::_test_page { path page } {
  346. variable $path
  347. upvar 0 $path data
  348. if { [set pos [lsearch $data(pages) $page]] == -1 } {
  349. return -code error "page \"$page\" does not exists"
  350. }
  351. return $pos
  352. }
  353. # ------------------------------------------------------------------------------
  354. # Command NoteBook::_itemconfigure
  355. # ------------------------------------------------------------------------------
  356. proc NoteBook::_itemconfigure { path page lres } {
  357. variable $path
  358. upvar 0 $path data
  359. set res [Widget::configure $path.f$page $lres]
  360. if { [Widget::hasChanged $path.f$page -text foo] } {
  361. _compute_width $path
  362. } elseif { [Widget::hasChanged $path.f$page -image foo] } {
  363. set data(hpage) [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
  364. _compute_width $path
  365. }
  366. if { [Widget::hasChanged $path.f$page -state state] &&
  367. $state == "disabled" && $data(select) == $page } {
  368. set data(select) ""
  369. }
  370. return $res
  371. }
  372. # ------------------------------------------------------------------------------
  373. # Command NoteBook::_compute_width
  374. # ------------------------------------------------------------------------------
  375. proc NoteBook::_compute_width { path } {
  376. variable $path
  377. upvar 0 $path data
  378. set font [Widget::getoption $path -font]
  379. set wmax 0
  380. set hmax $data(hpage)
  381. set wtot 0
  382. if { ![info exists data(textid)] } {
  383. set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
  384. }
  385. set id $data(textid)
  386. $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
  387. foreach page $data(pages) {
  388. $path:cmd itemconfigure $id -text [Widget::getoption $path.f$page -text]
  389. set wtext [expr {[lindex [$path:cmd bbox $id] 2]+20}]
  390. if { [set img [Widget::getoption $path.f$page -image]] != "" } {
  391. set wtext [expr {$wtext+[image width $img]+4}]
  392. set himg [expr {[image height $img]+6}]
  393. if { $himg > $hmax } {
  394. set hmax $himg
  395. }
  396. }
  397. set wmax [expr {$wtext>$wmax ? $wtext : $wmax}]
  398. incr wtot $wtext
  399. set data($page,width) $wtext
  400. }
  401. if { [Widget::getoption $path -homogeneous] } {
  402. foreach page $data(pages) {
  403. set data($page,width) $wmax
  404. }
  405. set wtot [expr {$wmax * [llength $data(pages)]}]
  406. }
  407. set data(hpage) $hmax
  408. set data(wpage) $wtot
  409. }
  410. # ------------------------------------------------------------------------------
  411. # Command NoteBook::_get_x_page
  412. # ------------------------------------------------------------------------------
  413. proc NoteBook::_get_x_page { path pos } {
  414. variable _warrow
  415. variable $path
  416. upvar 0 $path data
  417. set base $data(base)
  418. set x [expr {$_warrow+1}]
  419. if { $pos < $base } {
  420. foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
  421. incr x [expr {-$data($page,width)}]
  422. }
  423. } elseif { $pos > $base } {
  424. foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
  425. incr x $data($page,width)
  426. }
  427. }
  428. return $x
  429. }
  430. # ------------------------------------------------------------------------------
  431. # Command NoteBook::_xview
  432. # ------------------------------------------------------------------------------
  433. proc NoteBook::_xview { path inc } {
  434. variable $path
  435. upvar 0 $path data
  436. if { $inc == -1 } {
  437. set base [expr {$data(base)-1}]
  438. set dx $data([lindex $data(pages) $base],width)
  439. } else {
  440. set dx [expr {-$data([lindex $data(pages) $data(base)],width)}]
  441. set base [expr {$data(base)+1}]
  442. }
  443. if { $base >= 0 && $base < [llength $data(pages)] } {
  444. set data(base) $base
  445. $path:cmd move page $dx 0
  446. _draw_area $path
  447. _draw_arrows $path
  448. }
  449. }
  450. # ------------------------------------------------------------------------------
  451. # Command NoteBook::_highlight
  452. # ------------------------------------------------------------------------------
  453. proc NoteBook::_highlight { type path page } {
  454. variable $path
  455. upvar 0 $path data
  456. if { ![string compare [Widget::getoption $path.f$page -state] "disabled"] } {
  457. return
  458. }
  459. switch -- $type {
  460. on {
  461. $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -activebackground]
  462. $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -activeforeground]
  463. }
  464. off {
  465. $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -background]
  466. $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -foreground]
  467. }
  468. }
  469. }
  470. # ------------------------------------------------------------------------------
  471. # Command NoteBook::_select
  472. # ------------------------------------------------------------------------------
  473. proc NoteBook::_select { path page } {
  474. variable $path
  475. upvar 0 $path data
  476. if { ![string compare [Widget::getoption $path.f$page -state] "normal"] } {
  477. set oldsel $data(select)
  478. if { [string compare $page $oldsel] } {
  479. if { $oldsel != "" } {
  480. if { [set cmd [Widget::getoption $path.f$oldsel -leavecmd]] != "" } {
  481. if { [set code [catch {uplevel \#0 $cmd} res]] == 1 || $res == 0 } {
  482. return -code $code $res
  483. }
  484. }
  485. set data(select) ""
  486. _draw_page $path $oldsel 0
  487. }
  488. set data(select) $page
  489. if { $page != "" } {
  490. if { !$data($page,realized) } {
  491. set data($page,realized) 1
  492. if { [set cmd [Widget::getoption $path.f$page -createcmd]] != "" } {
  493. uplevel \#0 $cmd
  494. }
  495. }
  496. if { [set cmd [Widget::getoption $path.f$page -raisecmd]] != "" } {
  497. uplevel \#0 $cmd
  498. }
  499. _draw_page $path $page 0
  500. }
  501. _draw_area $path
  502. }
  503. }
  504. }
  505. # ------------------------------------------------------------------------------
  506. # Command NoteBook::_redraw
  507. # ------------------------------------------------------------------------------
  508. proc NoteBook::_redraw { path } {
  509. variable $path
  510. upvar 0 $path data
  511. if { !$data(realized) } {
  512. return
  513. }
  514. foreach page $data(pages) {
  515. _draw_page $path $page 0
  516. }
  517. _draw_area $path
  518. _draw_arrows $path
  519. }
  520. # ------------------------------------------------------------------------------
  521. # Command NoteBook::_draw_page
  522. # ------------------------------------------------------------------------------
  523. proc NoteBook::_draw_page { path page create } {
  524. variable $path
  525. upvar 0 $path data
  526. # --- calcul des coordonnees et des couleurs de l'onglet ---------------------------------
  527. set pos [lsearch $data(pages) $page]
  528. set bg [Widget::getoption $path -background]
  529. set h $data(hpage)
  530. set xd [_get_x_page $path $pos]
  531. set xf [expr {$xd + $data($page,width)}]
  532. set lt [list $xd $h $xd 4 [expr {$xd+3}] 1 $xf 1]
  533. set lb [list $xf 1 [expr {$xf+3}] 4 [expr {$xf+3}] [expr {$h-3}] [expr {$xf+6}] $h]
  534. set img [Widget::getoption $path.f$page -image]
  535. if { $data(select) == $page } {
  536. set fgt $data(lbg)
  537. set fgb $data(dbg)
  538. set ytext [expr {$h/2-1}]
  539. if { $img == "" } {
  540. set xtext [expr {$xd+9}]
  541. } else {
  542. set ximg [expr {$xd+9}]
  543. set xtext [expr {$ximg+[image width $img]+4}]
  544. }
  545. set bd [Widget::getoption $path -borderwidth]
  546. set fg [Widget::getoption $path -foreground]
  547. } else {
  548. set fgt $data(dbg)
  549. set fgb $fgt
  550. set ytext [expr {$h/2}]
  551. if { $img == "" } {
  552. set xtext [expr {$xd+10}]
  553. } else {
  554. set ximg [expr {$xd+10}]
  555. set xtext [expr {$ximg+[image width $img]+4}]
  556. }
  557. set bd 1
  558. if { [Widget::getoption $path.f$page -state] == "normal" } {
  559. set fg [Widget::getoption $path -foreground]
  560. } else {
  561. set fg [Widget::getoption $path -disabledforeground]
  562. }
  563. }
  564. # --- creation ou modification de l'onglet -----------------------------------------------
  565. if { $create } {
  566. eval $path:cmd create polygon [concat $lt $lb] \
  567. -tag {"page p:$page $page:poly"} \
  568. -outline $bg \
  569. -fill $bg
  570. eval $path:cmd create line $lt -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
  571. eval $path:cmd create line $lb -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
  572. $path:cmd create text $xtext $ytext \
  573. -text [Widget::getoption $path.f$page -text] \
  574. -font [Widget::getoption $path -font] \
  575. -fill $fg \
  576. -anchor w \
  577. -tags "page p:$page $page:text"
  578. $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
  579. $path:cmd bind p:$page <Enter> "NoteBook::_highlight on $path $page"
  580. $path:cmd bind p:$page <Leave> "NoteBook::_highlight off $path $page"
  581. } else {
  582. eval $path:cmd coords "$page:poly" [concat $lt $lb]
  583. eval $path:cmd coords "$page:top" $lt
  584. eval $path:cmd coords "$page:bot" $lb
  585. $path:cmd coords "$page:text" $xtext $ytext
  586. $path:cmd itemconfigure "$page:poly" -fill $bg -outline $bg
  587. $path:cmd itemconfigure "$page:top" -fill $fgt -width $bd
  588. $path:cmd itemconfigure "$page:bot" -fill $fgb -width $bd
  589. $path:cmd itemconfigure "$page:text" \
  590. -text [Widget::getoption $path.f$page -text] \
  591. -font [Widget::getoption $path -font] \
  592. -fill $fg
  593. }
  594. if { $img != "" } {
  595. if { [set id [$path:cmd find withtag $page:img]] == "" } {
  596. $path:cmd create image $ximg $ytext \
  597. -image $img \
  598. -anchor w \
  599. -tags "page p:$page $page:img"
  600. } else {
  601. $path:cmd coords $id $ximg $ytext
  602. $path:cmd itemconfigure $id -image $img
  603. }
  604. } else {
  605. $path:cmd delete $page:img
  606. }
  607. if { $data(select) == $page } {
  608. $path:cmd raise p:$page
  609. } elseif { $pos == 0 } {
  610. if { $data(select) == "" } {
  611. $path:cmd raise p:$page
  612. } else {
  613. $path:cmd lower p:$page p:$data(select)
  614. }
  615. } else {
  616. set pred [lindex $data(pages) [expr {$pos-1}]]
  617. if { $data(select) != $pred || $pos == 1 } {
  618. $path:cmd lower p:$page p:$pred
  619. } else {
  620. $path:cmd lower p:$page p:[lindex $data(pages) [expr {$pos-2}]]
  621. }
  622. }
  623. }
  624. # ------------------------------------------------------------------------------
  625. # Command NoteBook::_draw_arrows
  626. # ------------------------------------------------------------------------------
  627. proc NoteBook::_draw_arrows { path } {
  628. variable _warrow
  629. variable $path
  630. upvar 0 $path data
  631. set w [expr {[winfo width $path]-1}]
  632. set h [expr {$data(hpage)-1}]
  633. set nbpages [llength $data(pages)]
  634. set xl 0
  635. set xr [expr {$w-$_warrow+1}]
  636. if { $data(base) > 0 } {
  637. if { ![llength [$path:cmd find withtag "leftarrow"]] } {
  638. $path:cmd create window $xl 1 \
  639. -width $_warrow \
  640. -height $h \
  641. -anchor nw \
  642. -window $path.fg \
  643. -tags "leftarrow"
  644. } else {
  645. $path:cmd coords "leftarrow" $xl 1
  646. $path:cmd itemconfigure "leftarrow" -width $_warrow -height $h
  647. }
  648. } else {
  649. $path:cmd delete "leftarrow"
  650. }
  651. if { $data(base) < $nbpages-1 &&
  652. $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
  653. if { ![llength [$path:cmd find withtag "rightarrow"]] } {
  654. $path:cmd create window $xr 1 \
  655. -width $_warrow \
  656. -height $h \
  657. -window $path.fd \
  658. -anchor nw \
  659. -tags "rightarrow"
  660. } else {
  661. $path:cmd coords "rightarrow" $xr 1
  662. $path:cmd itemconfigure "rightarrow" -width $_warrow -height $h
  663. }
  664. } else {
  665. $path:cmd delete "rightarrow"
  666. }
  667. }
  668. # ------------------------------------------------------------------------------
  669. # Command NoteBook::_draw_area
  670. # ------------------------------------------------------------------------------
  671. proc NoteBook::_draw_area { path } {
  672. variable $path
  673. upvar 0 $path data
  674. set w [expr {[winfo width $path]-1}]
  675. set h [expr {[winfo height $path]-1}]
  676. set bd [Widget::getoption $path -borderwidth]
  677. set x0 [expr {$bd-1}]
  678. set y0 $data(hpage)
  679. set y1 $h
  680. set dbg $data(dbg)
  681. set sel $data(select)
  682. if { $sel == "" } {
  683. set xd [expr {$w/2}]
  684. set xf $xd
  685. set lbg $data(dbg)
  686. } else {
  687. set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
  688. set xf [expr {$xd + $data($sel,width)+6}]
  689. set lbg $data(lbg)
  690. }
  691. if { [llength [$path:cmd find withtag rect]] } {
  692. $path:cmd coords "toprect1" $xd $y0 $x0 $y0 $x0 $h
  693. $path:cmd coords "toprect2" $w $y0 $xf $y0
  694. $path:cmd coords "botrect" $x0 $h $w $h $w $y0
  695. $path:cmd itemconfigure "toprect1" -fill $lbg -width $bd
  696. $path:cmd itemconfigure "toprect2" -fill $lbg -width $bd
  697. $path:cmd itemconfigure "botrect" -width $bd
  698. $path:cmd raise "rect"
  699. } else {
  700. $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
  701. -tags "rect toprect1" -fill $lbg -width $bd
  702. $path:cmd create line $w $y0 $xf $y0 \
  703. -tags "rect toprect2" -fill $lbg -width $bd
  704. $path:cmd create line 1 $h $w $h $w $y0 \
  705. -tags "rect botrect" -fill $dbg -width $bd
  706. }
  707. if { $sel != "" } {
  708. if { [llength [$path:cmd find withtag "window"]] } {
  709. $path:cmd coords "window" 2 [expr {$y0+1}]
  710. $path:cmd itemconfigure "window" \
  711. -width [expr {$w-3}] \
  712. -height [expr {$h-$y0-3}] \
  713. -window $path.f$sel
  714. } else {
  715. set y0 $data(hpage)
  716. $path:cmd create window 2 [expr {$y0+1}] \
  717. -width [expr {$w-3}] \
  718. -height [expr {$h-$y0-3}] \
  719. -anchor nw \
  720. -tags "window" \
  721. -window $path.f$sel
  722. }
  723. } else {
  724. $path:cmd delete "window"
  725. }
  726. }
  727. # ------------------------------------------------------------------------------
  728. # Command NoteBook::_resize
  729. # ------------------------------------------------------------------------------
  730. proc NoteBook::_resize { path } {
  731. _draw_area $path
  732. _draw_arrows $path
  733. }
  734. # ------------------------------------------------------------------------------
  735. # Command NoteBook::_realize
  736. # ------------------------------------------------------------------------------
  737. proc NoteBook::_realize { path } {
  738. variable $path
  739. upvar 0 $path data
  740. if { [set width [Widget::getoption $path -width]] == 0 ||
  741. [set height [Widget::getoption $path -height]] == 0 } {
  742. compute_size $path
  743. }
  744. set data(realized) 1
  745. _draw_area $path
  746. _draw_arrows $path
  747. bind $path <Configure> "NoteBook::_resize $path"
  748. }