home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / histwmttoo.tcl < prev    next >
Text File  |  1997-07-14  |  6KB  |  239 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)histwmttoo.tcl    /main/titanic/1
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)histwmttoo.tcl    /main/titanic/1   14 Jul 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "wmttool.tcl"
  15.  
  16. Class HistWmtTool : {WmtTool} {
  17.     method destructor
  18.     constructor
  19.     method insertHistEntry
  20.     method removeHistEntry
  21.     method renumberHist
  22.     method loadHist
  23.     method saveHist
  24.     method addHistory
  25.     method removeHistory
  26.     attribute historySet
  27. }
  28.  
  29. method HistWmtTool::destructor {this} {
  30.     # Start destructor user section
  31.     # End destructor user section
  32.     $this WmtTool::destructor
  33. }
  34.  
  35. constructor HistWmtTool {class this name} {
  36.     set this [WmtTool::constructor $class $this $name]
  37.     $this historySet [List new]
  38.     return $this
  39. }
  40.  
  41. method HistWmtTool::insertHistEntry {this entry} {
  42.     set l [[$this historySet] length]
  43.     if {[isCommand [$this exitButton]]} {
  44.         set index [llength [[[$this exitButton] menu] entrySet]]
  45.         incr index -3
  46.         incr index -$l
  47.     } else {
  48.         return
  49.     }
  50.     # entry does not need to exist
  51.     set entryLvlPth [$entry levelPath]
  52.     [$this historySet] foreach hist {
  53.         if {$entryLvlPth != [$hist levelPath]} {
  54.             continue
  55.         }
  56.         $this removeHistory $hist
  57.         $hist delete
  58.     }
  59.     [$this historySet] insert $entry
  60.     if {[[$this historySet] length] > 5} {
  61.         [[$this historySet] index end] delete
  62.         [$this historySet] remove end
  63.     }
  64.     $this renumberHist
  65.     [$this historySet] foreach hist {
  66.         $hist index $index
  67.         incr index
  68.     }
  69. }
  70.  
  71. method HistWmtTool::removeHistEntry {this levelPath} {
  72.     [$this historySet] foreach hist {
  73.         if {$levelPath == [$hist levelPath]} {
  74.             $this removeHistory $hist
  75.             $hist delete
  76.             break
  77.         }
  78.     }
  79.     $this renumberHist
  80. }
  81.  
  82. method HistWmtTool::renumberHist {this} {
  83.     set m 1
  84.     [$this historySet] foreach entry {
  85.         $entry config -label "$m [$entry abbrev]" -mnemonic $m
  86.         incr m
  87.     }
  88. }
  89.  
  90. method HistWmtTool::loadHist {this context} {
  91.     set history [m4_var get M4_file_history -context $context]
  92.     if {"$history" == ""} {
  93.         return
  94.     }
  95.  
  96.     if {[isCommand [$this exitButton]]} {
  97.         set index [[$this exitButton] index]
  98.         incr index -1
  99.     } else {
  100.         # no exit button -> no history
  101.         return
  102.     }
  103.     # be sure to have 5 entries only
  104.     set history [lrange $history 0 4]
  105.  
  106.     set mnem 1
  107.     foreach levelPath $history {
  108.         if {[string index $history 0] != "/"} {
  109.             continue
  110.         }
  111.         set entry [$this mkHistEntry $levelPath $mnem]
  112.         $this addHistory $entry
  113.         $entry index $index
  114.         incr index
  115.         incr mnem
  116.     }
  117. }
  118.  
  119. method HistWmtTool::saveHist {this context} {
  120.     set history ""
  121.     [$this historySet] foreach entry {
  122.         lappend history [$entry levelPath]
  123.     }
  124.     if {$history != [m4_var get M4_file_history -context $context]} {
  125.         m4_var set M4_file_history $history -context $context
  126.     }
  127. }
  128.  
  129. proc HistWmtTool::abbrevLevelPath {levelPath} {
  130.     set shortPath ""
  131.     append levelPath "/"
  132.     for {set count 0; set slash [string first "/" $levelPath]} \
  133.         {$slash >= 0} \
  134.         {incr count; set slash [string first "/" $levelPath]} {
  135.         if {$slash != 0} {
  136.             set sep ""
  137.             set part2 ""
  138.             set befSlash $slash
  139.             incr befSlash -1
  140.             set level [string range $levelPath 0 $befSlash]
  141.             if {$count != 2} {
  142.                 append shortPath "/"
  143.             }
  144.             case $count in {
  145.                 1 {
  146.                     # Corporate: leave out
  147.                     set part1 ""
  148.                 }
  149.                 {2 3} {
  150.                     # Project and ConfigVersion
  151.                     set part1 $level
  152.                 }
  153.                 default {
  154.                     # Typed object
  155.                     set sep "."
  156.                 }
  157.             }
  158.             if {$sep != ""} {
  159.                 set sepPos [string last $sep $level]
  160.                 if {$sepPos < 0} {
  161.                     set sep ""
  162.                 } else {
  163.                     set befSepPos $sepPos    
  164.                     incr befSepPos -1
  165.                     set part1 [string range $level \
  166.                                 0 $befSepPos]
  167.                     if {$count == 4} {
  168.                         # Do not show type of Phase
  169.                         set sep ""
  170.                     } else {
  171.                         set aftSepPos $sepPos    
  172.                         incr aftSepPos
  173.                         set part2 [string range \
  174.                             $level $aftSepPos end]
  175.                     }
  176.                 }
  177.             }
  178.             set part2 [string range $part2 0 2]
  179.             append shortPath ${part1}${sep}$part2
  180.         }
  181.         set aftSlash $slash
  182.         incr aftSlash
  183.         set levelPath [string range $levelPath $aftSlash end]
  184.     }
  185.     set maxlen 32
  186.     set plen [string length $shortPath]
  187.     if {$count < 5 || $plen <= $maxlen} {
  188.         return $shortPath
  189.     }
  190.     set lvlLen ""
  191.     set lvlSet [split $shortPath /]
  192.     foreach level $lvlSet {
  193.         set l [string length $level]
  194.         incr l
  195.         lappend lvlLen $l
  196.     }
  197.     set llast [llength $lvlSet]
  198.     incr llast -1
  199.     set minlb 2
  200.     set minhb $llast
  201.     incr minhb -1
  202.         set minav $maxlen
  203.     incr minav -6
  204.     incr minav -[lindex $lvlLen 1]
  205.     incr minav -[lindex $lvlLen $llast]
  206.     if {$minav > 0} {
  207.         for {set lb 2} {$lb < $llast} {incr lb} {
  208.             set avail $maxlen
  209.             incr avail -$plen
  210.             incr avail -4
  211.             for {set hb $lb} {$hb < $llast} {incr hb} {
  212.                 incr avail [lindex $lvlLen $hb]
  213.                 if {$avail > -1} {
  214.                     if {$avail < $minav} {
  215.                         set minlb $lb
  216.                         set minhb $hb
  217.                         set minav $avail
  218.                     }
  219.                     break
  220.                 }
  221.             }
  222.         }
  223.     }
  224.     set lvlSet [lreplace $lvlSet $minlb $minhb ...]
  225.     return [join $lvlSet /]
  226. }
  227.  
  228. # Do not delete this line -- regeneration end marker
  229.  
  230. method HistWmtTool::addHistory {this newHistory} {
  231.     [$this historySet] append $newHistory
  232.  
  233. }
  234.  
  235. method HistWmtTool::removeHistory {this oldHistory} {
  236.     [$this historySet] removeValue $oldHistory
  237. }
  238.  
  239.