home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / showversio.tcl < prev    next >
Text File  |  1997-06-27  |  2KB  |  83 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1994
  4. #
  5. #      File:           @(#)showversio.tcl    /main/titanic/6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)showversio.tcl    /main/titanic/6   27 Jun 1997 Copyright 1994 Westmount Technology
  10.  
  11. require procs.tcl
  12.  
  13. proc showVersionDialog {{title "About"} {showProcessInfo 0}} {
  14.     set dlg .main.versionDialog
  15.     if {![isCommand $dlg]} {
  16.     TemplateDialog new $dlg \
  17.         -modal $win95 \
  18.         -title $title
  19.     $dlg delCancelButton
  20.     $dlg delHelpButton
  21.     interface DlgColumn $dlg.top {
  22.         DlgRow r {
  23.         Image wmt {
  24.             pixmap wmt
  25.         }
  26.         DlgColumn c {
  27.             Label prodTool {
  28.             text "ObjectTeam"
  29.             }
  30.             Label version {}
  31.             Label date {}
  32.         }
  33.         }
  34.     }
  35.     $dlg.top.r.c.version text [versionInfo versionLabel]
  36.     $dlg.top.r.c.date text [versionInfo dateLabel]
  37.  
  38.     if $showProcessInfo {
  39.         HorSeparator new $dlg.top.sep
  40.         Label new $dlg.top.space2
  41.         set lineCnt 0
  42.         foreach header {User Host "Process Id"} {
  43.         set row [DlgRow new $dlg.top.row$lineCnt \
  44.             -spaceType NONE \
  45.             -justification RIGHT]
  46.         Label new $row.label \
  47.             -text "$header:" \
  48.             -alignment RIGHT \
  49.             -justification TOP \
  50.             -horStretchFactor 10 \
  51.             -font "courier-bold-12"
  52.         DlgColumn new $row.col
  53.  
  54.         case "$header" in {
  55.             {User} {
  56.             set info [ORB::currentUser]
  57.             }
  58.             {Host} {
  59.             set info [ORB::currentHost]
  60.             }
  61.             {"Process Id"} {
  62.             set info [ORB::currentProcessId]
  63.             }
  64.         }
  65.  
  66.         set breakUpCnt 0
  67.         foreach line [split $info "\n"] {
  68.             foreach part [lineBreak $line 25 " "] {
  69.             set text [format "%-25s" $part]
  70.             Label new $row.col.label$breakUpCnt \
  71.                 -text $text \
  72.                 -font "courier-normal-12"
  73.             incr breakUpCnt
  74.             }
  75.         }
  76.         incr lineCnt
  77.         }
  78.     }
  79.     }
  80.  
  81.     $dlg popUp
  82. }
  83.