1# $Id$ 2 3option add *Customize.varforeground blue widgetDefault 4option add *Customize.groupnameforeground blue widgetDefault 5 6namespace eval custom { 7 # Filename for saving options 8 set options(customfile) [file join $::configdir custom.tcl] 9 10 # -1: stored values haven't been restored yet (only config changes vars) 11 # 0: stored values are being restored now 12 # 1: stored values have been restored (changes may be stored) 13 set custom_loaded -1 14} 15 16proc custom::defgroup {id doc args} { 17 variable group 18 19 if {![info exists group(members,$id)]} { 20 set group(members,$id) {} 21 } 22 if {![info exists group(subgroups,$id)]} { 23 set group(subgroups,$id) {} 24 } 25 set group(doc,$id) $doc 26 set group(tag,$id) $id 27 if {![info exists group(parents,$id)]} { 28 set group(parents,$id) {} 29 } 30 31 foreach {attr val} $args { 32 switch -- $attr { 33 -tag {set group(tag,$id) $val} 34 -group { 35 lappend group(subgroups,$val) [list group $id] 36 set group(subgroups,$val) [lrmdups $group(subgroups,$val)] 37 lappend group(parents,$id) $val 38 set group(parents,$id) [lrmdups $group(parents,$id)] 39 } 40 -type { 41 set group(type,$id) $val 42 } 43 } 44 } 45} 46 47 48proc custom::defvar {vname value doc args} { 49 variable var 50 variable group 51 52 set fullname [uplevel 1 {namespace current}]::$vname 53 54 if {[info exists $fullname]} { 55 set v [set $fullname] 56 57 if {![info exists var(default,$fullname)]} { 58 set var(config,$fullname) $v 59 } 60 61 # Removing any existing trace 62 unset $fullname 63 set $fullname $v 64 } else { 65 set $fullname $value 66 } 67 68 trace variable $fullname w \ 69 [list [namespace current]::on_var_change $fullname] 70 71 set var(default,$fullname) $value 72 set var(doc,$fullname) $doc 73 set var(type,$fullname) string 74 set var(state,$fullname) "" 75 76 eval { configvar $fullname } $args 77} 78 79proc custom::on_var_change {varname args} { 80 variable options 81 variable var 82 variable custom_loaded 83 84 switch -- $custom_loaded { 85 -1 { 86 set var(config,$varname) [set $varname] 87 } 88 0 { } 89 1 { 90 # Store variable if it has been changed by 91 # any procedure which is not in ::custom namespace 92 if {[namespace qualifiers [caller]] != [namespace current]} { 93 # Don't store loginconf here 94 # (storing all loginconf except password may be 95 # confusing) 96 if {![regexp {^(::)+loginconf\(.*\)} $varname]} { 97 store_vars $varname 98 } 99 } 100 } 101 } 102} 103 104proc custom::add_radio_options {vname values} { 105 variable var 106 107 set fullname [uplevel 1 {namespace current}]::$vname 108 109 if {![info exists $fullname]} { 110 return 111 } 112 113 set var(values,$fullname) [concat $var(values,$fullname) $values] 114} 115 116proc custom::configvar {fullname args} { 117 variable var 118 variable group 119 120 if {![info exists $fullname]} { 121 error "No such variable: $fullname" 122 } 123 124 foreach {attr val} $args { 125 switch -- $attr { 126 -type { 127 set var(type,$fullname) $val 128 } 129 -group { 130 if {![info exists group(members,$val)]} { 131 set group(members,$val) {} 132 } 133 if {[lsearch -exact $group(members,$val) [list var $fullname]] < 0} { 134 lappend group(members,$val) [list var $fullname] 135 } 136 } 137 -values { 138 set var(values,$fullname) $val 139 } 140 -layout { 141 set var(layout,$fullname) $val 142 } 143 } 144 } 145 146 switch -- $var(type,$fullname) { 147 radio { 148 set q 0 149 foreach {v d} $var(values,$fullname) { 150 if {$v == [set $fullname]} { 151 set q 1 152 } 153 } 154 if {!$q} { 155 set $fullname $var(default,$fullname) 156 } 157 } 158 } 159 160 foreach {attr val} $args { 161 switch -- $attr { 162 -command { 163 trace variable $fullname w $val 164 } 165 } 166 } 167} 168 169custom::defgroup Tkabber \ 170 [::msgcat::mc "Customization of the One True Jabber Client."] 171 172custom::defgroup Hidden "Hidden group" -group Tkabber -tag "Hidden group" \ 173 -type hidden 174 175############################################################################### 176 177proc custom::open_window {gid} { 178 set w .customize 179 if {[winfo exists $w]} { 180 raise_win $w 181 goto $gid 182 focus $w.fields 183 return 184 } 185 186 add_win $w -title [::msgcat::mc "Customize"] \ 187 -tabtitle [::msgcat::mc "Customize"] \ 188 -class Customize \ 189 -raise 1 190 #-raisecmd "focus [list $w.input]" 191 192 193 set sw [ScrolledWindow $w.sw] 194 set t [text $w.fields -wrap word -background [$w cget -background]] 195 $sw setwidget $t 196 197 198 frame $w.navigate 199 button $w.navigate.back -text <- \ 200 -command [list [namespace current]::history_move 1] 201 button $w.navigate.forward -text -> \ 202 -command [list [namespace current]::history_move -1] 203 button $w.navigate.toplevel -text Tkabber \ 204 -command [list [namespace current]::goto Tkabber] 205 label $w.navigate.lab -text [::msgcat::mc "Group:"] 206 Entry $w.navigate.entry -textvariable [namespace current]::curgroup \ 207 -command [list [namespace current]::go] 208 button $w.navigate.browse -text [::msgcat::mc "Open"] \ 209 -command [list [namespace current]::go] 210 211 pack $w.navigate.back $w.navigate.forward \ 212 $w.navigate.toplevel $w.navigate.lab -side left 213 pack $w.navigate.entry -side left -expand yes -fill x 214 pack $w.navigate.browse -side left 215 pack $w.navigate -side top -fill x 216 217 218 pack $sw -side top -fill both -expand yes 219 220 221 $t tag configure var -underline no \ 222 -foreground [option get $w varforeground Customize] 223 $t tag configure groupname -underline no \ 224 -foreground [option get $w groupnameforeground Customize] 225 226 bind $t <Key-Down> [list %W yview scroll 1 unit] 227 bind $t <Key-Up> [list %W yview scroll -1 unit] 228 bind $t <Key-Next> [list %W yview scroll 1 page] 229 bind $t <Key-Prior> [list %W yview scroll -1 page] 230 231 variable history 232 set history(pos) 0 233 set history(list) {} 234 235 variable curgroup $gid 236 237 hook::run open_custom_post_hook $w 238 239 update idletasks 240 goto $gid 241 242 focus $t 243} 244 245proc custom::go {} { 246 variable curgroup 247 goto $curgroup 248} 249 250proc custom::goto {gid} { 251 history_add $gid 252 fill_group .customize.fields $gid 0 253} 254 255proc custom::fill_group {t gid offset} { 256 variable group 257 variable var 258 variable curgroup 259 260 set curgroup $gid 261 262 $t configure -state normal 263 264 $t delete 1.0 end 265 266 if {![info exists group(members,$gid)]} { 267 $t configure -state disabled 268 return 269 } 270 271 set i 0 272 273 if {[info exists group(parents,$gid)] && $group(parents,$gid) != {}} { 274 foreach parent $group(parents,$gid) { 275 set b [button $t.gr$i -text $group(tag,$parent) \ 276 -cursor left_ptr \ 277 -command [list [namespace current]::goto $parent]] 278 $t window create end -window $b 279 $t insert end " " 280 bindscroll $b $t 281 282 incr i 283 } 284 if {[llength $group(parents,$gid)] == 1} { 285 $t insert end [::msgcat::mc "Parent group"] 286 } else { 287 $t insert end [::msgcat::mc "Parent groups"] 288 } 289 $t insert end "\n\n" 290 } 291 292 set butwidth 0 293 foreach member [concat $group(members,$gid) \ 294 [lsort -dictionary -index 1 $group(subgroups,$gid)]] { 295 lassign $member type data 296 switch -- $type { 297 group { 298 if {[info exists group(type,$data)] && \ 299 [cequal $group(type,$data) "hidden"]} { 300 continue 301 } 302 $t insert end "\n" 303 set b [button $t.gr$i -text "$group(tag,$data)" \ 304 -width $butwidth \ 305 -cursor left_ptr \ 306 -command [list [namespace current]::goto $data]] 307 $t window create end -window $b 308 if {$butwidth < [string length "$group(tag,$data)"]} { 309 set butwidth [string length "$group(tag,$data)"] 310 for {set j 0} {$j <= $i} {incr j} { 311 if {[winfo exists $t.gr$j]} { 312 $t.gr$j configure -width $butwidth 313 } 314 } 315 } 316 bindscroll $b $t 317 318 $t insert end " $group(doc,$data)" 319 320 bindtags $b [lreplace [bindtags $b] 1 0 $t] 321 322 $t insert end "\n" 323 } 324 var { 325 $t insert end $data var ": " 326 327 fill_var $t $data $i 328 329 $t insert end "\n" 330 331 } 332 } 333 incr i 334 } 335 336 $t configure -state disabled 337 $t yview moveto $offset 338} 339 340proc custom::fill_var {t varname idx} { 341 variable var 342 variable tmp 343 344 switch -- $var(type,$varname) { 345 string { 346 catch {unset tmp($varname)} 347 trace variable [namespace current]::tmp($varname) w \ 348 [list [namespace current]::on_edit $varname] 349 set tmp($varname) [set $varname] 350 set e [entry $t.entry$idx \ 351 -textvariable [namespace current]::tmp($varname)] 352 $t window create end -window $e 353 bindscroll $e $t 354 $t insert end "\n" 355 } 356 357 password { 358 catch {unset tmp($varname)} 359 trace variable [namespace current]::tmp($varname) w \ 360 [list [namespace current]::on_edit $varname] 361 set tmp($varname) [set $varname] 362 set e [entry $t.entry$idx -show * \ 363 -textvariable [namespace current]::tmp($varname)] 364 $t window create end -window $e 365 bindscroll $e $t 366 $t insert end "\n" 367 } 368 369 boolean { 370 catch {unset tmp($varname)} 371 trace variable [namespace current]::tmp($varname) w \ 372 [list [namespace current]::on_edit $varname] 373 set tmp($varname) [set $varname] 374 set cb [checkbutton $t.cb$idx -cursor left_ptr \ 375 -variable [namespace current]::tmp($varname)] 376 $t window create end -window $cb 377 bindscroll $cb $t 378 $t insert end "\n" 379 } 380 381 integer { 382 catch {unset tmp($varname)} 383 trace variable [namespace current]::tmp($varname) w \ 384 [list [namespace current]::on_edit $varname] 385 set tmp($varname) [set $varname] 386 set e [Spinbox $t.spin$idx -1000000000 1000000000 1 \ 387 [namespace current]::tmp($varname)] 388 $t window create end -window $e 389 bindscroll $e $t 390 $t insert end "\n" 391 } 392 393 options { 394 catch {unset tmp($varname)} 395 catch {unset var(temp,$varname)} 396 trace variable [namespace current]::tmp($varname) w \ 397 [list [namespace current]::on_edit $varname] 398 trace variable [namespace current]::var(temp,$varname) w \ 399 [list [namespace current]::on_change $t $varname] 400 set var(temp,$varname) [set $varname] 401 set tmp($varname) [set $varname] 402 set options {} 403 foreach {val text} $var(values,$varname) { 404 lappend options $text 405 } 406 set opt [eval [list OptionMenu $t.opt$idx \ 407 [namespace current]::var(temp,$varname)] \ 408 $options] 409 $t.opt$idx configure -cursor left_ptr 410 $t window create end -window $t.opt$idx 411 bindscroll $t.opt$idx $t 412 $t insert end "\n" 413 } 414 415 list { 416 if {![info exists var(values,$varname)]} return 417 418 catch {unset tmp($varname)} 419 trace variable [namespace current]::tmp($varname) w \ 420 [list [namespace current]::on_edit $varname] 421 set tmp($varname) [set $varname] 422 set fr [frame $t.fr$idx -cursor left_ptr] 423 trace variable [namespace current]::tmp($varname) w \ 424 [list [namespace current]::on_change $fr.lb $varname] 425 set sw [ScrolledWindow $fr.sw] 426 set lb [listbox $fr.lb -cursor left_ptr \ 427 -selectmode extended -height 3 -exportselection false] 428 eval [list $lb] insert end $var(values,$varname) 429 $sw setwidget $lb 430 pack $sw 431 foreach i $tmp($varname) { 432 $lb selection set $i 433 } 434 bind $lb <<ListboxSelect>> \ 435 [double% "set [namespace current]::tmp($varname) \[$lb curselection\]"] 436 $t window create end -window $fr -align top 437 $t insert end "\n" 438 } 439 440 radio { 441 catch {unset tmp($varname)} 442 trace variable [namespace current]::tmp($varname) w \ 443 [list [namespace current]::on_edit $varname] 444 set tmp($varname) [set $varname] 445 if {[info exists var(layout,$varname)] && \ 446 [string first v $var(layout,$varname)] == 0} { 447 set anchor w 448 set side top 449 } else { 450 set anchor n 451 set side left 452 } 453 set fr [frame $t.fr$idx -cursor left_ptr] 454 set i 0 455 foreach {val displ} $var(values,$varname) { 456 set rb [radiobutton $fr.rb$i -cursor left_ptr \ 457 -text $displ -value $val \ 458 -variable [namespace current]::tmp($varname)] 459 pack $rb -anchor $anchor -side $side 460 bindscroll $rb $t 461 incr i 462 } 463 $t window create end -window $fr -align top 464 bindscroll $fr $t 465 $t insert end "\n" 466 } 467 468 font { 469 catch {unset tmp($varname)} 470 trace variable [namespace current]::tmp($varname) w \ 471 [list [namespace current]::on_edit $varname] 472 set tmp($varname) [set $varname] 473 set fr [frame $t.fr$idx -cursor left_ptr] 474 trace variable [namespace current]::tmp($varname) w \ 475 [list [namespace current]::on_change $fr.selectfont $varname] 476 set sf [SelectFont $fr.selectfont -type toolbar \ 477 -font $tmp($varname) \ 478 -command [list [namespace current]::on_set_font \ 479 $fr.selectfont $varname]] 480 pack $sf 481 bindscroll $sf $t 482 $t window create end -window $fr 483 bindscroll $fr $t 484 $t insert end "\n" 485 } 486 487 file { 488 catch {unset tmp($varname)} 489 trace variable [namespace current]::tmp($varname) w \ 490 [list [namespace current]::on_edit $varname] 491 set tmp($varname) [set $varname] 492 set e [entry $t.entry$idx -width 30 \ 493 -textvariable [namespace current]::tmp($varname)] 494 set browse \ 495 [button $t.browse$idx -text [::msgcat::mc "Browse..."] \ 496 -cursor left_ptr \ 497 -command [list [namespace current]::get_filename $varname]] 498 $t window create end -window $e 499 $t window create end -window $browse 500 bindscroll $e $t 501 bindscroll $browse $t 502 $t insert end "\n" 503 } 504 505 default { 506 $t insert end "\n" 507 } 508 } 509 510 set b [menubutton $t.stb$idx -text [::msgcat::mc "State"] \ 511 -cursor left_ptr \ 512 -menu $t.stb$idx.statemenu -relief $::tk_relief] 513 create_state_menu $b.statemenu $varname 514 $t window create end -window $b 515 bindscroll $b $t 516 set l [label $t.stl$idx \ 517 -textvariable [namespace current]::var(state,$varname)] 518 $t insert end " " 519 $t window create end -window $l 520 bindscroll $l $t 521 $t insert end "\n" 522 523 $t insert end "$var(doc,$varname)\n" 524} 525 526proc custom::get_filename {varname} { 527 variable tmp 528 529 set args {} 530 if {$tmp($varname) == ""} { 531 lappend args -initialdir $::configdir 532 } else { 533 lappend args -initialdir [file dirname $tmp($varname)] \ 534 -initialfile [file tail $tmp($varname)] 535 } 536 set filename [eval tk_getOpenFile $args] 537 if {$filename != ""} { 538 set tmp($varname) $filename 539 } 540} 541 542proc custom::on_change {w varname args} { 543 variable var 544 variable tmp 545 546 if {![winfo exists $w]} { 547 return 548 } 549 550 switch -- $var(type,$varname) { 551 font { 552 $w configure -font $tmp($varname) 553 } 554 list { 555 $w selection clear 0 end 556 foreach i $tmp($varname) { 557 $w selection set $i 558 } 559 } 560 options { 561 foreach {val text} $var(values,$varname) { 562 if {$text == $var(temp,$varname) && \ 563 (![info exists tmp($varname)] || \ 564 $tmp($varname) != $val)} { 565 set tmp($varname) $val 566 break 567 } 568 } 569 } 570 } 571} 572 573proc custom::on_set_font {sf varname} { 574 variable tmp 575 576 set tmp($varname) [$sf cget -font] 577} 578 579proc custom::on_edit {varname args} { 580 variable var 581 variable tmp 582 variable saved 583 584 switch -- $var(type,$varname) { 585 options { 586 foreach {val text} $var(values,$varname) { 587 if {$tmp($varname) == $val && \ 588 (![info exists var(temp,$varname)] || \ 589 $var(temp,$varname) != $text)} { 590 set var(temp,$varname) $text 591 break 592 } 593 } 594 } 595 } 596 597 set is_default [cequal [set $varname] $var(default,$varname)] 598 if {[info exists var(config,$varname)]} { 599 set is_config [cequal [set $varname] $var(config,$varname)] 600 } else { 601 set is_config -1 602 } 603 set is_current [cequal [set $varname] $tmp($varname)] 604 if {[info exists saved($varname)]} { 605 set is_saved [cequal [set $varname] $saved($varname)] 606 } else { 607 set is_saved -1 608 } 609 610 if {!$is_current} { 611 set st [::msgcat::mc "value is changed, but the option is not set."] 612 } else { 613 switch -glob -- $is_default,$is_config,$is_saved { 614 0,0,1 - 615 0,-1,1 {set st [::msgcat::mc "the option is set and saved."]} 616 *,*,0 - 617 0,0,-1 - 618 0,-1,-1 {set st [::msgcat::mc "the option is set, but not saved."]} 619 *,1,* {set st [::msgcat::mc "the option is taken from config file."]} 620 1,*,* {set st [::msgcat::mc "the option is set to its default value."]} 621 } 622 } 623 624 set var(state,$varname) $st 625} 626 627 628proc custom::create_state_menu {m varname} { 629 variable var 630 variable saved 631 632 if {[winfo exists $m]} { 633 destroy $m 634 } 635 636 menu $m -tearoff 0 637 $m add command -label [::msgcat::mc "Set for current session only"] \ 638 -command [list [namespace current]::set_for_current_sess $varname] 639 $m add command -label [::msgcat::mc "Set for current and future sessions"] \ 640 -command [list [namespace current]::save_var $varname] 641 $m add command -label [::msgcat::mc "Reset to current value"] \ 642 -command [list [namespace current]::reset_to_current $varname] 643 $m add command -label [::msgcat::mc "Reset to saved value"] \ 644 -command [list [namespace current]::reset_to_saved $varname] \ 645 -state [expr {[info exists saved($varname)] ? "normal" : "disabled"}] 646 $m add command -label [::msgcat::mc "Reset to value from config file"] \ 647 -command [list [namespace current]::reset_to_config $varname] \ 648 -state [expr {[info exists var(config,$varname)] ? "normal" : "disabled"}] 649 $m add command -label [::msgcat::mc "Reset to default value"] \ 650 -command [list [namespace current]::reset_to_default $varname] 651 652 return $m 653} 654 655proc custom::set_for_current_sess {varname} { 656 variable var 657 variable tmp 658 variable saved 659 660 set $varname $tmp($varname) 661 662 on_edit $varname 663} 664 665proc custom::reset_to_current {varname} { 666 variable var 667 variable tmp 668 variable saved 669 670 set tmp($varname) [set $varname] 671 672 on_edit $varname 673} 674 675proc custom::reset_to_saved {varname} { 676 variable var 677 variable tmp 678 variable saved 679 680 if {![info exists saved($varname)]} return 681 682 set tmp($varname) $saved($varname) 683 set $varname $saved($varname) 684 685 on_edit $varname 686} 687 688proc custom::reset_to_config {varname} { 689 variable var 690 variable tmp 691 variable saved 692 693 if {![info exists var(config,$varname)]} return 694 695 set tmp($varname) $var(config,$varname) 696 set $varname $var(config,$varname) 697 698 on_edit $varname 699} 700 701proc custom::reset_to_default {varname} { 702 variable var 703 variable tmp 704 variable saved 705 706 set tmp($varname) $var(default,$varname) 707 set $varname $var(default,$varname) 708 709 on_edit $varname 710} 711 712proc custom::save_var {varname} { 713 variable var 714 variable tmp 715 variable saved 716 717 set saved($varname) $tmp($varname) 718 set $varname $tmp($varname) 719 720 store 721 722 on_edit $varname 723} 724 725proc custom::store {} { 726 variable var 727 variable saved 728 variable options 729 730 lassign [TempFile] tempfile fd 731 fconfigure $fd -encoding utf-8 732 733 foreach varname [array names saved] { 734 if {[info exists var(config,$varname)]} { 735 if {$saved($varname) != $var(config,$varname)} { 736 puts $fd [list [list $varname $saved($varname)]] 737 } 738 } else { 739 if {![info exists var(default,$varname)] || \ 740 $saved($varname) != $var(default,$varname)} { 741 puts $fd [list [list $varname $saved($varname)]] 742 } 743 } 744 } 745 746 close $fd 747 catch {file attributes $tempfile -permissions 00600} 748 file rename -force $tempfile $options(customfile) 749} 750 751proc ::custom::TempFile {} { 752 set maxtries 10 753 set access [list RDWR CREAT EXCL TRUNC] 754 set permission 0600 755 set fd "" 756 757 for {set i 0} {$i < $maxtries} {incr i} { 758 set newname [file join $::configdir custom[rand 1000000000]] 759 760 if {![file exists $newname]} { 761 if {![catch {open $newname $access $permission} fd]} { 762 fconfigure $fd -translation binary 763 return [list $newname $fd] 764 } 765 } 766 } 767 if {$fd == ""} { 768 return -code error \ 769 "failed to find an unused temporary file name" 770 } else { 771 return -code error \ 772 [format "failed to open a temporary file: %s" $fd] 773 } 774} 775 776proc custom::store_vars {args} { 777 variable saved 778 779 foreach varname $args { 780 set saved($varname) [set $varname] 781 } 782 783 store 784} 785 786proc custom::restore {} { 787 variable var 788 variable saved 789 variable options 790 variable custom_loaded 791 792 set custom_loaded 0 793 794 if {[file readable $options(customfile)]} { 795 set fd [open $options(customfile) r] 796 fconfigure $fd -encoding utf-8 797 798 set opts [read $fd] 799 close $fd 800 801 foreach opt $opts { 802 lassign $opt varname value 803 804 # HACK: ::plugins::loaded(*) variables must be processed first 805 if {[string match ::plugins::loaded(*) $varname]} { 806 set saved($varname) $value 807 catch {set $varname $value} 808 } 809 } 810 811 foreach opt $opts { 812 lassign $opt varname value 813 814 # HACK: matching variables other than ::plugins::loaded(*) 815 # TODO: What to do with variables which namespace isn't created? 816 if {![string match ::plugins::loaded(*) $varname]} { 817 set saved($varname) $value 818 catch {set $varname $value} 819 } 820 } 821 } 822 823 foreach idx [array names var default,*] { 824 set varname [string range $idx 8 end] 825 826 if {![info exists saved($varname)]} { 827 # We have to trigger commands bound to the variable 828 # if it was set in config or as default 829 catch {set $varname [set $varname]} 830 } 831 } 832 833 set custom_loaded 1 834} 835 836hook::add postload_hook custom::restore 60 837 838 839proc custom::update_page_offset {} { 840 variable history 841 842 if {[llength $history(list)] == 0} return 843 844 lassign [.customize.fields yview] offset 845 lassign [lindex $history(list) $history(pos)] page 846 847 set history(list) [lreplace $history(list) $history(pos) $history(pos) \ 848 [list $page $offset]] 849} 850 851proc custom::history_move {shift} { 852 variable history 853 variable curgroup 854 855 set newpos [expr {$history(pos) + $shift}] 856 857 if {$newpos < 0} { 858 return 859 } 860 861 if {$newpos >= [llength $history(list)]} { 862 return 863 } 864 865 update_page_offset 866 867 lassign [lindex $history(list) $newpos] newgroup offset 868 set history(pos) $newpos 869 history_set_buttons 870 871 set curgroup $newgroup 872 873 fill_group .customize.fields $newgroup $offset 874} 875 876 877proc custom::history_add {gid} { 878 variable history 879 880 update_page_offset 881 882 set history(list) [lreplace $history(list) 0 [expr {$history(pos) - 1}]] 883 884 lvarpush history(list) [list $gid 0] 885 set history(pos) 0 886 history_set_buttons 887 888 debugmsg custom [array get history] 889} 890 891proc custom::history_set_buttons {} { 892 variable history 893 894 if {$history(pos) == 0} { 895 .customize.navigate.forward configure -state disabled 896 } else { 897 .customize.navigate.forward configure -state normal 898 } 899 900 if {$history(pos) + 1 == [llength $history(list)]} { 901 .customize.navigate.back configure -state disabled 902 } else { 903 .customize.navigate.back configure -state normal 904 } 905} 906 907############################################################################## 908 909proc custom::restore_window {gid args} { 910 open_window $gid 911} 912 913proc custom::save_session {vsession} { 914 upvar 2 $vsession session 915 global usetabbar 916 variable history 917 918 # We don't need JID at all, so make it empty (special case) 919 set user "" 920 set server "" 921 set resource "" 922 923 # TODO 924 if {!$usetabbar} return 925 926 set prio 0 927 foreach page [.nb pages] { 928 set path [ifacetk::nbpath $page] 929 930 if {[string equal $path .customize]} { 931 lassign [lindex $history(list) $history(pos)] gid 932 lappend session [list $prio $user $server $resource \ 933 [list [namespace current]::restore_window $gid] \ 934 ] 935 } 936 incr prio 937 } 938} 939 940hook::add save_session_hook [namespace current]::custom::save_session 941 942# vim:ts=8:sw=4:sts=4:noet 943