home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / Linux / Divers / remind-03.00.19.tgz / remind-03.00.19.tar / remind-03.00.19 / build.tk < prev    next >
Text File  |  1998-03-01  |  23KB  |  752 lines
  1. #!/bin/sh
  2. # -*-Mode: TCL;-*-
  3.  
  4. #--------------------------------------------------------------
  5. #   BUILD.TK
  6. #
  7. #   A cheesy graphical front-end for building and installing REMIND.
  8. #
  9. #   This file is part of REMIND.
  10. #   Copyright (C) 1992-1998 by David F. Skoll
  11. #
  12. #--------------------------------------------------------------
  13.  
  14. # $Id: build.tk,v 1.6 1998/03/01 21:03:36 dfs Exp $
  15.  
  16. # the next line restarts using wish \
  17. exec wish "$0" "$@"
  18.  
  19. #***********************************************************************
  20. # %PROCEDURE: SetConfigDefaults
  21. # %ARGUMENTS:
  22. #  None
  23. # %RETURNS:
  24. #  Nothing
  25. # %DESCRIPTION:
  26. #  Sets up default values for various parameters.
  27. #***********************************************************************
  28. proc SetConfigDefaults {} {
  29.     global Config
  30.     set Config(LAT_DEG) 45
  31.     set Config(LAT_MIN) 24
  32.     set Config(LON_DEG) 75
  33.     set Config(LON_MIN) 39
  34.     set Config(LOCATION) "Ottawa"
  35.     set Config(DEFAULT_PAGE) "Letter"
  36.     set Config(DATESEP) "/"
  37.     set Config(TIMESEP) ":"
  38.     set Config(ISOLATIN1) 0
  39.     set Config(IBMEXTENDED) 0
  40.     set Config(ISOLATIN2) 0
  41.     set Config(IBM852) 0
  42.     set Config(NORTHERN_HEMISPHERE) 1
  43.     set Config(WESTERN_HEMISPHERE) 1
  44.     set Config(LANGUAGE) "English"
  45. }
  46.  
  47. #***********************************************************************
  48. # %PROCEDURE: Bail
  49. # %ARGUMENTS:
  50. #  msg -- a message
  51. # %RETURNS:
  52. #  Does not return
  53. # %DESCRIPTION:
  54. #  Pops up an error dialog; then calls exit.
  55. #***********************************************************************
  56. proc Bail { msg } {
  57.     tk_dialog .err "Remind Configuration Error" $msg error 0 "Bummer"
  58.     exit 1
  59. }
  60.  
  61. #***********************************************************************
  62. # %PROCEDURE: CheckSanity
  63. # %ARGUMENTS:
  64. #  None
  65. # %RETURNS:
  66. #  Nothing
  67. # %DESCRIPTION:
  68. #  Checks sanity of install dir -- checks for critical files,
  69. #  warns user if something looks wrong.
  70. #***********************************************************************
  71. proc CheckSanity {} {
  72.     if {![file executable ./configure]} {
  73.     wm withdraw .
  74.     Bail "I can't seem to execute the file ./configure -- make sure you have all required files and are running this from the top-level Remind directory"
  75.     }
  76.     if {![file readable ./src/custom.h.in]} {
  77.     wm withdraw .
  78.     Bail "I can't seem to find the file src/custom.h.in -- make sure you have all required files and are running this from the top-level Remind directory"
  79.     }
  80. }
  81.  
  82. #***********************************************************************
  83. # %PROCEDURE: CreateMainDialog
  84. # %ARGUMENTS:
  85. #  None
  86. # %RETURNS:
  87. #  Nothing
  88. # %DESCRIPTION:
  89. #  Creates and displays the main configuration dialog
  90. #***********************************************************************
  91. proc CreateMainDialog {} {
  92.     global Instdir Loc Options
  93.  
  94.     wm title . "Remind Configuration"
  95.     wm iconname . "Remind Config"
  96.  
  97.     SetConfigDefaults
  98.     tabnotebook_create .tn
  99.  
  100.     set Instdir [tabnotebook_page .tn "Installation Directories"]
  101.     CreateInstallDirDialog $Instdir
  102.  
  103.     set Loc [tabnotebook_page .tn "Location"]
  104.     CreateLocationDialog $Loc
  105.  
  106.     set Options [tabnotebook_page .tn "Options"]
  107.     CreateOptionsDialog $Options
  108.     pack .tn -side top -expand 1 -fill both
  109.  
  110.     frame .buttons
  111.     button .build -text "Build Remind" -command BuildRemind
  112.     button .cancel -text "Cancel" -command exit
  113.  
  114.     pack .build .cancel -in .buttons -side left -expand 1 -fill both
  115.     pack .buttons -side top -expand 0 -fill x
  116. }
  117.  
  118. #***********************************************************************
  119. # %PROCEDURE: CreateInstallDirDialog
  120. # %ARGUMENTS:
  121. #  w -- frame containing widgets
  122. # %RETURNS:
  123. #  Nothing
  124. # %DESCRIPTION:
  125. #  Creates the "installation directories" dialog.
  126. #***********************************************************************
  127. proc CreateInstallDirDialog { w } {
  128.     label $w.binlabel -text "Location for programs: "
  129.     entry $w.bin -width 30
  130.     $w.bin insert end "/usr/local/bin"
  131.  
  132.     label $w.manlabel -text "Location for man pages: "
  133.     entry $w.man -width 30
  134.     $w.man insert end "/usr/local/man"
  135.  
  136.     text $w.blurb -width 1 -height 5 -wrap word -relief flat -takefocus 0
  137.     $w.blurb insert end "\n(Tabbed-notebook Tcl code taken from \"Effective Tcl/Tk Programming\" by Mark Harrison and Michael McLennan, Addison-Wesley Professional Computing Series.)"
  138.     $w.blurb configure -state disabled
  139.     # Disable all text-window behaviour
  140.     bindtags $w.blurb {NoSuchTag}
  141.     grid $w.binlabel -row 0 -column 0 -sticky e
  142.     grid $w.bin -row 0 -column 1 -sticky nsew
  143.     grid $w.manlabel -row 1 -column 0 -sticky e
  144.     grid $w.man -row 1 -column 1 -sticky nsew
  145.     grid $w.blurb - -sticky nsew
  146. }
  147.  
  148. #***********************************************************************
  149. # %PROCEDURE: CreateLocationDialog
  150. # %ARGUMENTS:
  151. #  w -- frame containing dialog
  152. # %RETURNS:
  153. #  Nothing
  154. # %DESCRIPTION:
  155. #  Creates the location dialog
  156. #***********************************************************************
  157. proc CreateLocationDialog { w } {
  158.     global Config
  159.     scale $w.latdeg -label "Latitude (degrees)" -orient horizontal \
  160.         -from 0 -to 89 -length 300 -variable Config(LAT_DEG)
  161.     scale $w.latmin -label "Latitude (minutes)" -orient horizontal \
  162.         -from 0 -to 59 -length 300 -variable Config(LAT_MIN)
  163.     scale $w.londeg -label "Longitude (degrees)" -orient horizontal \
  164.         -from 0 -to 179 -length 300 -variable Config(LON_DEG)
  165.     scale $w.lonmin -label "Longtude (minutes)" -orient horizontal \
  166.         -from 0 -to 59 -length 300 -variable Config(LON_MIN)
  167.  
  168.     radiobutton $w.north -text "Northern Hemisphere" \
  169.         -variable Config(NORTHERN_HEMISPHERE) -value 1
  170.     radiobutton $w.south -text "Southern Hemisphere" \
  171.         -variable Config(NORTHERN_HEMISPHERE) -value 0
  172.     radiobutton $w.west -text "Western Hemisphere" \
  173.         -variable Config(WESTERN_HEMISPHERE) -value 1
  174.     radiobutton $w.east -text "Eastern Hemisphere" \
  175.         -variable Config(WESTERN_HEMISPHERE) -value 0
  176.  
  177.     label $w.loclab -text "City or Town: "
  178.     entry $w.location -width 20
  179.     $w.location insert end $Config(LOCATION)
  180.     grid $w.latdeg -
  181.     grid $w.latmin -
  182.     grid $w.londeg -
  183.     grid $w.lonmin -
  184.  
  185.     grid $w.north $w.west
  186.     grid $w.south $w.east
  187.     grid $w.loclab -sticky e 
  188.     grid $w.location -sticky nsew -row 6 -column 1
  189. }
  190.  
  191. #***********************************************************************
  192. # %PROCEDURE: CreateOptionsDialog
  193. # %ARGUMENTS:
  194. #  w -- frame containing dialog
  195. # %RETURNS:
  196. #  Nothing
  197. # %DESCRIPTION:
  198. #  Creates the options dialog
  199. #***********************************************************************
  200. proc CreateOptionsDialog { w } {
  201.     global Config
  202.  
  203.     label $w.pagelabel -text "Default page size: "
  204.     menubutton $w.page -text $Config(DEFAULT_PAGE) \
  205.         -indicatoron 1 -relief raised \
  206.         -menu $w.page.menu
  207.     menu $w.page.menu -tearoff 0
  208.     $w.page.menu add command -label "Letter" \
  209.         -command "$w.page configure -text Letter"
  210.     $w.page.menu add command -label "A4" -command "$w.page configure -text A4"
  211.  
  212.     grid configure $w.pagelabel -row 0 -column 0 -sticky e
  213.     grid configure $w.page -row 0 -column 1 -sticky nsew
  214.  
  215.     label $w.datelabel -text "Default date separator: "
  216.     menubutton $w.date -text $Config(DATESEP) -indicatoron 1 -relief raised \
  217.         -menu $w.date.menu
  218.     menu $w.date.menu -tearoff 0
  219.     $w.date.menu add command -label "/" -command "$w.date configure -text /"
  220.     $w.date.menu add command -label "-" -command "$w.date configure -text -"
  221.  
  222.     grid configure $w.datelabel -row 1 -column 0 -sticky e
  223.     grid configure $w.date -row 1 -column 1 -sticky nsew
  224.  
  225.     label $w.timelabel -text "Default time separator: "
  226.     menubutton $w.time -text $Config(TIMESEP) -indicatoron 1 -relief raised \
  227.         -menu $w.time.menu
  228.     menu $w.time.menu -tearoff 0
  229.     $w.time.menu add command -label ":" -command "$w.time configure -text :"
  230.     $w.time.menu add command -label "." -command "$w.time configure -text ."
  231.  
  232.     grid configure $w.timelabel -row 2 -column 0 -sticky e
  233.     grid configure $w.time -row 2 -column 1 -sticky nsew
  234.  
  235.     label $w.charlabel -text "Character set: "
  236.     menubutton $w.char -text "ISO 8859-1" -indicatoron 1 -relief raised \
  237.         -menu $w.char.menu
  238.     menu $w.char.menu -tearoff 0
  239.     $w.char.menu add command -label "ISO 8859-1" -command "$w.char configure -text {ISO 8859-1}"
  240.     $w.char.menu add command -label "ISO 8859-2" -command "$w.char configure -text {ISO 8859-2}"
  241.     $w.char.menu add command -label "IBM Extended" -command "$w.char configure -text {IBM Extended}"
  242.     $w.char.menu add command -label "IBM CPI-852" -command "$w.char configure -text {ISO 8859-2}"
  243.     $w.char.menu add command -label "Plain ASCII" -command "$w.char configure -text {Plain ASCII}"
  244.  
  245.     grid configure $w.charlabel -row 3 -column 0 -sticky e
  246.     grid configure $w.char -row 3 -column 1 -sticky nsew
  247.  
  248.     label $w.langlabel -text "Language: "
  249.     menubutton $w.lang -text $Config(LANGUAGE) -indicatoron 1 -relief raised \
  250.         -menu $w.lang.menu
  251.     menu $w.lang.menu -tearoff 0
  252.     foreach lang {
  253.     "Brazilian Portuguese"
  254.     "Danish"
  255.     "Dutch"
  256.     "English"
  257.     "Finnish"
  258.     "French"
  259.     "German"
  260.     "Italian"
  261.     "Norwegian"
  262.     "Polish"
  263.     "Romanian"
  264.     } {
  265.     $w.lang.menu add command -label $lang -command [list $w.lang configure -text $lang]
  266.     }
  267.  
  268.     grid configure $w.langlabel -row 4 -column 0 -sticky e
  269.     grid configure $w.lang -row 4 -column 1 -sticky nsew
  270.  
  271. }
  272.  
  273. #***********************************************************************
  274. # %PROCEDURE: BuildRemind
  275. # %ARGUMENTS:
  276. #  None
  277. # %RETURNS:
  278. #  Nothing
  279. # %DESCRIPTION:
  280. #  Builds Remind by:
  281. #  -- creating custom.h from custom.h.in
  282. #  -- running ./configure
  283. #  -- running make
  284. #***********************************************************************
  285. proc BuildRemind {} {
  286.     pack forget .tn
  287.     pack forget .buttons
  288.     wm title . "Remind Configuration Status"
  289.     text .msgs -width 80 -height 25 -wrap char -yscrollcommand ".sb set"
  290.     scrollbar .sb -orient vertical -command ".msgs yview"
  291.  
  292.     .msgs tag configure green -foreground #005500
  293.     .msgs tag configure red -foreground #990000
  294.     pack .msgs -side left -expand 1 -fill both
  295.     pack .sb -side left -expand 0 -fill y
  296.  
  297.     update
  298.  
  299.     .msgs insert end "\n>>> Creating src/custom.h...\n\n" green
  300.     CreateCustomH
  301.     .msgs insert end ">>> Calling `./configure'...\n\n" green
  302.     CallConfigure
  303.     .msgs insert end ">>> Calling `make'...\n\n" green
  304.     CallMake
  305.     .msgs insert end "\n----------------------------------------------\n\n"
  306.     .msgs insert end "Remind" red
  307.     .msgs insert end " has been built.  To install it, type:\n\n"
  308.     .msgs insert end "make install\n\n" green
  309.     .msgs insert end "from the top-level "
  310.     .msgs insert end "Remind" red
  311.     .msgs insert end " directory.  (You may need to be root.)\n\n"
  312.     .msgs insert end "After it's installed, create an empty file called:\n"
  313.     .msgs insert end "       \$HOME/.reminders\n" green
  314.     .msgs insert end "and type "
  315.     .msgs insert end "tkremind" green
  316.     .msgs insert end " for a nice easy introduction to "
  317.     .msgs insert end "Remind.\n\n" red
  318.     .msgs insert end "Press me to exit --> "
  319.     button .msgs.ok -text "OK" -command "exit"
  320.     .msgs window create end -window .msgs.ok
  321.     .msgs see end
  322. }
  323.  
  324. #***********************************************************************
  325. # %PROCEDURE: RunCommand
  326. # %ARGUMENTS:
  327. #  cmd -- shell command to run
  328. # %RETURNS:
  329. #  Return code of command
  330. # %DESCRIPTION:
  331. #  Runs a command putting output into ".msgs"
  332. #***********************************************************************
  333. proc RunCommand { cmd } {
  334.     global CmdDone
  335.  
  336.     set CmdDone 0
  337.  
  338.     .msgs insert end "$cmd\n" red
  339.  
  340.     set problem [catch {set CmdFile [open "|$cmd" "r"]} err]
  341.     if {$problem} {
  342.     Bail "Error running command `$cmd': $err"
  343.     }
  344.  
  345.     fconfigure $CmdFile -blocking 0
  346.  
  347.     fileevent $CmdFile readable "CommandReadable $CmdFile"
  348.     vwait CmdDone
  349.  
  350.     set problem [catch {close $CmdFile} err]
  351.     if {$problem} {
  352.     Bail "Error running command `$cmd': $err"
  353.     }
  354.  
  355. }
  356.  
  357. #***********************************************************************
  358. # %PROCEDURE: CommandReadable
  359. # %ARGUMENTS:
  360. #  f -- file to read from
  361. # %RETURNS:
  362. #  Nothing
  363. # %DESCRIPTION:
  364. #  Reads characters from command pipelin and appends them to .msg.
  365. #***********************************************************************
  366. proc CommandReadable { f } {
  367.     global CmdDone
  368.     set stuff [read $f]
  369.     .msgs insert end $stuff
  370.     .msgs see end
  371.     if {[eof $f]} {
  372.     set CmdDone 1
  373.     }
  374. }
  375.  
  376. #***********************************************************************
  377. # %PROCEDURE: CallConfigure
  378. # %ARGUMENTS:
  379. #  None
  380. # %RETURNS:
  381. #  Nothing
  382. # %DESCRIPTION:
  383. #  Executes "./configure" with appropriate arguments
  384. # %PRECONDITIONS:
  385. #  Any preconditions
  386. # %POSTCONDITIONS:
  387. #  Any postconditions
  388. # %SIDE EFFECTS:
  389. #  Any side effects
  390. #***********************************************************************
  391. proc CallConfigure {} {
  392.     global Instdir
  393.     set bin [$Instdir.bin get]
  394.     set man [$Instdir.man get]
  395.     RunCommand "./configure --bindir=$bin --mandir=$man"
  396. }
  397.  
  398. #***********************************************************************
  399. # %PROCEDURE: CreateCustomH
  400. # %ARGUMENTS:
  401. #  None
  402. # %RETURNS:
  403. #  Nothing
  404. # %DESCRIPTION:
  405. #  Creates "src/custom.h" from "src/custom.h.in"
  406. #***********************************************************************
  407. proc CreateCustomH {} {
  408.     global Loc Options Config
  409.     set problem [catch {set in [open "src/custom.h.in" "r"]} err]
  410.     if {$problem} {
  411.     Bail "Can't read src/custom.h.in: $err"
  412.     }
  413.     set problem [catch {set out [open "src/custom.h" "w"]} err]
  414.     if {$problem} {
  415.     Bail "Can't write src/custom.h: $err"
  416.     }
  417.  
  418.     # Retrieve values
  419.     # The latitude/longitude ones are tied to the scales; we can't
  420.     # modify them willy-nilly
  421.     set LAT_DEG $Config(LAT_DEG)
  422.     set LAT_MIN $Config(LAT_MIN)
  423.     set LON_DEG $Config(LON_DEG)
  424.     set LON_MIN $Config(LON_MIN)
  425.     if {!$Config(NORTHERN_HEMISPHERE)} {
  426.     set LAT_DEG "-$LAT_DEG"
  427.     set LAT_MIN "-$LAT_MIN"
  428.     }
  429.     if {!$Config(WESTERN_HEMISPHERE)} {
  430.     set LON_DEG "-$LON_DEG"
  431.     set LON_MIN "-$LON_MIN"
  432.     }
  433.     set Config(LOCATION) [$Loc.location get]
  434.  
  435.     switch -- [$Options.page cget -text] {
  436.     "A4" {
  437.         set Config(DEFAULT_PAGE) "{\"A4\", 595, 842}"
  438.     }
  439.     default {
  440.         set Config(DEFAULT_PAGE) "{\"Letter\", 612, 792}"
  441.     }
  442.     }
  443.     set Config(DATESEP) [$Options.date cget -text]
  444.     set Config(TIMESEP) [$Options.time cget -text]
  445.  
  446.     switch -- [$Options.char cget -text] {
  447.     "ISO 8859-1" {
  448.         set Config(ISOLATIN1) 1
  449.     }
  450.     "ISO 8859-2" {
  451.         set Config(ISOLATIN2) 1
  452.     }
  453.     "IBM CPI-852" {
  454.         set Config(IBM852) 1
  455.     }
  456.     "IBM Extended" {
  457.         set Config(IBMEXTENDED) 1
  458.     }
  459.     }
  460.  
  461.     while {[gets $in line] != -1} {
  462.     switch -glob -- $line {
  463.         "#define LAT_DEG *" {
  464.         puts $out "#define LAT_DEG $LAT_DEG"
  465.         .msgs insert end "#define LAT_DEG $LAT_DEG\n"
  466.         }
  467.         "#define LAT_MIN *" {
  468.         puts $out "#define LAT_MIN $LAT_MIN"
  469.         .msgs insert end "#define LAT_MIN $LAT_MIN\n"
  470.         }
  471.         "#define LON_DEG *" {
  472.         puts $out "#define LON_DEG $LON_DEG"
  473.         .msgs insert end "#define LON_DEG $LON_DEG\n"
  474.         }
  475.         "#define LON_MIN *" {
  476.         puts $out "#define LON_MIN $LON_MIN"
  477.         .msgs insert end "#define LON_MIN $LON_MIN\n"
  478.         }
  479.         "#define LOCATION *" {
  480.         puts $out "#define LOCATION \"$Config(LOCATION)\""
  481.         .msgs insert end "#define LOCATION \"$Config(LOCATION)\"\n"
  482.         }
  483.         "#define DEFAULT_PAGE *" {
  484.         puts $out "#define DEFAULT_PAGE $Config(DEFAULT_PAGE)"
  485.         .msgs insert end "#define DEFAULT_PAGE $Config(DEFAULT_PAGE)\n"
  486.         }
  487.         "#define DATESEP *" {
  488.         puts $out "#define DATESEP '$Config(DATESEP)'"
  489.         .msgs insert end "#define DATESEP '$Config(DATESEP)'\n"
  490.         }
  491.         "#define TIMESEP *" {
  492.         puts $out "#define TIMESEP '$Config(TIMESEP)'"
  493.         .msgs insert end "#define TIMESEP '$Config(TIMESEP)'\n"
  494.         }
  495.         "#define ISOLATIN1 *" {
  496.         puts $out "#define ISOLATIN1 $Config(ISOLATIN1)"
  497.         .msgs insert end "#define ISOLATIN1 $Config(ISOLATIN1)\n"
  498.         }
  499.         "#define ISOLATIN2 *" {
  500.         puts $out "#define ISOLATIN2 $Config(ISOLATIN2)"
  501.         .msgs insert end "#define ISOLATIN2 $Config(ISOLATIN2)\n"
  502.         }
  503.         "#define IBM852 *" {
  504.         puts $out "#define IBM852 $Config(IBM852)"
  505.         .msgs insert end "#define IBM852 $Config(IBM852)\n"
  506.         }
  507.         "#define IBMEXTENDED *" {
  508.         puts $out "#define IBMEXTENDED $Config(IBMEXTENDED)"
  509.         .msgs insert end "#define IBMEXTENDED $Config(IBMEXTENDED)\n"
  510.         }
  511.         default {
  512.         puts $out $line
  513.         }
  514.     }
  515.     }
  516.     close $in
  517.     close $out
  518. }
  519.  
  520. #***********************************************************************
  521. # %PROCEDURE: CallMake
  522. # %ARGUMENTS:
  523. #  None
  524. # %RETURNS:
  525. #  Nothing
  526. # %DESCRIPTION:
  527. #  Runs "make" with appropriate language definitions
  528. #***********************************************************************
  529. proc CallMake {} {
  530.     global Options
  531.     set lang [$Options.lang cget -text]
  532.     switch -- $lang {
  533.     "German" { set lang GERMAN }
  534.     "Dutch" { set lang DUTCH }
  535.     "Finnish" { set lang FINNISH }
  536.     "French" { set lang FRENCH }
  537.     "Norwegian" { set lang NORWEGIAN }
  538.     "Danish" { set lang DANISH }
  539.     "Polish" { set lang POLISH }
  540.     "Brazilian Portuguese" {set lang BRAZPORT }
  541.     "Italian" { set lang ITALIAN }
  542.     "Romanian" { set lang ROMANIAN }
  543.     default { set lang ENGLISH }
  544.     }
  545.     RunCommand "make \"LANGDEF=-DLANG=$lang\""
  546. }
  547.  
  548.  
  549. # Tabbed notebook code from "Effective Tcl/Tk Programming"
  550. # ----------------------------------------------------------------------
  551. #  EXAMPLE: tabnotebook that can dial up pages
  552. # ----------------------------------------------------------------------
  553. #  Effective Tcl/Tk Programming
  554. #    Mark Harrison, DSC Communications Corp.
  555. #    Michael McLennan, Bell Labs Innovations for Lucent Technologies
  556. #    Addison-Wesley Professional Computing Series
  557. # ======================================================================
  558. #  Copyright (c) 1996-1997  Lucent Technologies Inc. and Mark Harrison
  559. # ======================================================================
  560.  
  561. option add *Tabnotebook.tabs.background #666666 widgetDefault
  562. option add *Tabnotebook.margin 6 widgetDefault
  563. option add *Tabnotebook.tabColor #a6a6a6 widgetDefault
  564. option add *Tabnotebook.activeTabColor #d9d9d9 widgetDefault
  565. option add *Tabnotebook.tabFont \
  566.     -*-helvetica-bold-r-normal--*-120-* widgetDefault
  567.  
  568. proc tabnotebook_create {win} {
  569.     global tnInfo
  570.  
  571.     frame $win -class Tabnotebook
  572.     canvas $win.tabs -highlightthickness 0
  573.     pack $win.tabs -fill x
  574.  
  575.     notebook_create $win.notebook
  576.     pack $win.notebook -expand yes -fill both
  577.  
  578.     set tnInfo($win-tabs) ""
  579.     set tnInfo($win-current) ""
  580.     set tnInfo($win-pending) ""
  581.     return $win
  582. }
  583.  
  584. proc tabnotebook_page {win name} {
  585.     global tnInfo
  586.  
  587.     set page [notebook_page $win.notebook $name]
  588.     lappend tnInfo($win-tabs) $name
  589.  
  590.     if {$tnInfo($win-pending) == ""} {
  591.         set id [after idle [list tabnotebook_refresh $win]]
  592.         set tnInfo($win-pending) $id
  593.     }
  594.     return $page
  595. }
  596.  
  597. proc tabnotebook_refresh {win} {
  598.     global tnInfo
  599.  
  600.     $win.tabs delete all
  601.  
  602.     set margin [option get $win margin Margin]
  603.     set color [option get $win tabColor Color]
  604.     set font [option get $win tabFont Font]
  605.     set x 2
  606.     set maxh 0
  607.  
  608.     foreach name $tnInfo($win-tabs) {
  609.         set id [$win.tabs create text \
  610.             [expr $x+$margin+2] [expr -0.5*$margin] \
  611.             -anchor sw -text $name -font $font \
  612.             -tags [list $name]]
  613.  
  614.         set bbox [$win.tabs bbox $id]
  615.         set wd [expr [lindex $bbox 2]-[lindex $bbox 0]]
  616.         set ht [expr [lindex $bbox 3]-[lindex $bbox 1]]
  617.         if {$ht > $maxh} {
  618.             set maxh $ht
  619.         }
  620.  
  621.         $win.tabs create polygon 0 0  $x 0 \
  622.             [expr $x+$margin] [expr -$ht-$margin] \
  623.             [expr $x+$margin+$wd] [expr -$ht-$margin] \
  624.             [expr $x+$wd+2*$margin] 0 \
  625.             2000 0  2000 10  0 10 \
  626.             -outline black -fill $color \
  627.             -tags [list $name tab tab-$name]
  628.  
  629.         $win.tabs raise $id
  630.  
  631.         $win.tabs bind $name <ButtonPress-1> \
  632.             [list tabnotebook_display $win $name]
  633.  
  634.         set x [expr $x+$wd+2*$margin]
  635.     }
  636.     set height [expr $maxh+2*$margin]
  637.     $win.tabs move all 0 $height
  638.  
  639.     $win.tabs configure -width $x -height [expr $height+4]
  640.  
  641.     if {$tnInfo($win-current) != ""} {
  642.         tabnotebook_display $win $tnInfo($win-current)
  643.     } else {
  644.         tabnotebook_display $win [lindex $tnInfo($win-tabs) 0]
  645.     }
  646.     set tnInfo($win-pending) ""
  647. }
  648.  
  649. proc tabnotebook_display {win name} {
  650.     global tnInfo
  651.  
  652.     notebook_display $win.notebook $name
  653.  
  654.     set normal [option get $win tabColor Color]
  655.     $win.tabs itemconfigure tab -fill $normal
  656.  
  657.     set active [option get $win activeTabColor Color]
  658.     $win.tabs itemconfigure tab-$name -fill $active
  659.     $win.tabs raise $name
  660.  
  661.     set tnInfo($win-current) $name
  662. }
  663.  
  664. # ----------------------------------------------------------------------
  665. #  EXAMPLE: simple notebook that can dial up pages
  666. # ----------------------------------------------------------------------
  667. #  Effective Tcl/Tk Programming
  668. #    Mark Harrison, DSC Communications Corp.
  669. #    Michael McLennan, Bell Labs Innovations for Lucent Technologies
  670. #    Addison-Wesley Professional Computing Series
  671. # ======================================================================
  672. #  Copyright (c) 1996-1997  Lucent Technologies Inc. and Mark Harrison
  673. # ======================================================================
  674.  
  675. option add *Notebook.borderWidth 2 widgetDefault
  676. option add *Notebook.relief sunken widgetDefault
  677.  
  678. proc notebook_create {win} {
  679.     global nbInfo
  680.  
  681.     frame $win -class Notebook
  682.     pack propagate $win 0
  683.  
  684.     set nbInfo($win-count) 0
  685.     set nbInfo($win-pages) ""
  686.     set nbInfo($win-current) ""
  687.     return $win
  688. }
  689.  
  690. proc notebook_page {win name} {
  691.     global nbInfo
  692.  
  693.     set page "$win.page[incr nbInfo($win-count)]"
  694.     lappend nbInfo($win-pages) $page
  695.     set nbInfo($win-page-$name) $page
  696.  
  697.     frame $page
  698.  
  699.     if {$nbInfo($win-count) == 1} {
  700.         after idle [list notebook_display $win $name]
  701.     }
  702.     return $page
  703. }
  704.  
  705. proc notebook_display {win name} {
  706.     global nbInfo
  707.  
  708.     set page ""
  709.     if {[info exists nbInfo($win-page-$name)]} {
  710.         set page $nbInfo($win-page-$name)
  711.     } elseif {[winfo exists $win.page$name]} {
  712.         set page $win.page$name
  713.     }
  714.     if {$page == ""} {
  715.         error "bad notebook page \"$name\""
  716.     }
  717.  
  718.     notebook_fix_size $win
  719.  
  720.     if {$nbInfo($win-current) != ""} {
  721.         pack forget $nbInfo($win-current)
  722.     }
  723.     pack $page -expand yes -fill both
  724.     set nbInfo($win-current) $page
  725. }
  726.  
  727. proc notebook_fix_size {win} {
  728.     global nbInfo
  729.  
  730.     update idletasks
  731.  
  732.     set maxw 0
  733.     set maxh 0
  734.     foreach page $nbInfo($win-pages) {
  735.         set w [winfo reqwidth $page]
  736.         if {$w > $maxw} {
  737.             set maxw $w
  738.         }
  739.         set h [winfo reqheight $page]
  740.         if {$h > $maxh} {
  741.             set maxh $h
  742.         }
  743.     }
  744.     set bd [$win cget -borderwidth]
  745.     set maxw [expr $maxw+2*$bd]
  746.     set maxh [expr $maxh+2*$bd]
  747.     $win configure -width $maxw -height $maxh
  748. }
  749.  
  750. CheckSanity
  751. CreateMainDialog
  752.