home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / win.tcl < prev   
Encoding:
Text File  |  1999-04-21  |  14.3 KB  |  538 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Chuck's Additions - an Alpha hack
  4.  #
  5.  #  FILE: "win.tcl"
  6.  #                      created: 4/6/98
  7.  #                    last update: 21/4/1999 {11:59:36 pm}
  8.  #  Author: Chuck Gregory
  9.  #  E-mail: <cgregory@mail.arc.nasa.gov>
  10.  #    mail: Logicon
  11.  #          NASA Ames Research Center, Moffett Field, CA  94035
  12.  #
  13.  #  Description:
  14.  #
  15.  #    Window handling routines. All procs are bound in AlphaBits.tcl.
  16.  #      Recommend the following global interface preference settings:
  17.  #
  18.  #                    MacOS 8.0     MacOS < 8
  19.  #          defLeft         6             0
  20.  #          defTop        41            38
  21.  #          defWidth           510           510
  22.  #          horMargin             6             2
  23.  #          tileHeight         [707]           426
  24.  #          tileLeft             6             0
  25.  #          tileMargin        22            20
  26.  #          tileTop            41            38
  27.  #          tileWidth        [1014]           640
  28.  #
  29.  #  History:
  30.  #
  31.  #  modified  by   rev  reason
  32.  #  --------  ---  ---  -----------
  33.  #  04/06/98            7.1b6 original
  34.  #  04/08/98  czg  1.0  modified for MacOS 8
  35.  #  07/15/98  VMD       removed lisp'ish functions
  36.  #  07/21/98  czg  1.1  fixed margin bugs in shrinkLeft & shrinkRight;
  37.  #                    documented prefs recommendations
  38.  # ###################################################################
  39.  ##
  40.  
  41. proc shrinkHigh {} {
  42.     global numWinsToTile tileTop tileHeight tileMargin
  43.     set names [winNames -f]
  44.     set numWins [llength $names]
  45.     if {$numWins<2} {set numWins 2}
  46.     if {$numWins>$numWinsToTile} {set numWins $numWinsToTile}
  47.     set width [lindex [getGeometry] 2]
  48.     set height [expr {($tileHeight - $tileMargin) / $numWins}]
  49.     set text [getGeometry]
  50.     set left [lindex $text 0]
  51.     sizeWin $width $height
  52.     moveWin $left $tileTop
  53. }
  54.  
  55. proc shrinkLow {} {
  56.     global numWinsToTile tileTop tileHeight tileMargin
  57.     set names [winNames -f]
  58.     set numWins [llength $names]
  59.     if {$numWins<2} {set numWins 2}
  60.     if {$numWins>$numWinsToTile} {set numWins $numWinsToTile}
  61.     set width [lindex [getGeometry] 2]
  62.     set height [expr {($tileHeight - $tileMargin) / $numWins}]
  63.     set text [getGeometry]
  64.     set left [lindex $text 0]
  65.     sizeWin $width $height
  66.     moveWin $left [expr {$tileTop + $height + $tileMargin}]
  67. }
  68.  
  69. proc singlePage {} {shrinkFull}
  70. proc defaultSize {} {shrinkFull}
  71.  
  72. proc shrinkFull {} {
  73.     global tileTop tileHeight tileLeft defWidth
  74.     moveWin $tileLeft $tileTop
  75.     sizeWin $defWidth $tileHeight
  76. }
  77.  
  78. proc shrinkLeft {} {
  79.     global horMargin tileWidth tileLeft
  80.     set width [expr {($tileWidth-$horMargin)/2}]
  81.     set height [lindex [getGeometry] 3]
  82.     set text [getGeometry]
  83.     set top [lindex $text 1]
  84.     moveWin $tileLeft $top
  85.     sizeWin $width $height
  86. }
  87.  
  88. proc shrinkRight {} {
  89.     global horMargin tileWidth tileLeft
  90.     set width [expr {($tileWidth-$horMargin)/2}]
  91.     set height [lindex [getGeometry] 3]
  92.     set text [getGeometry]
  93.     set top [lindex $text 1]
  94.     moveWin [expr {$tileLeft + $width + $horMargin}] $top
  95.     sizeWin $width $height
  96. }
  97.  
  98. proc swapWithNext {} {
  99.     set files [winNames]
  100.     if {[llength $files] < 2} return
  101.     bringToFront [lindex $files 1]
  102. }
  103.     
  104.  
  105.  
  106. proc nextWindow {} {
  107.     global win::Active 
  108.     set files [winNames -f]
  109.     if {[llength $files] < 2} {return}
  110.     set f [lindex $files 0]
  111.     regsub -all {[][]} $f {\\\0} f
  112.     set aind [lsearch -exact ${win::Active} $f]
  113.     if {$aind < 0} {error "No win '$f'"}
  114.     set rng [lrange ${win::Active} 0 [expr {$aind-1}]]
  115.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  116.     set win::Active [lrange ${win::Active} 1 end]
  117.     lappend win::Active $f
  118.     regsub -all {\\([][])} [lindex ${win::Active} 0] {\1} w
  119.     bringToFront $w
  120. }
  121.  
  122.  
  123. proc prevWindow {} {
  124.     global win::Active 
  125.     set files [winNames -f]
  126.     if {[llength $files] < 2} {return}
  127.     set f [lindex $files 0]
  128.     regsub -all {[][]} $f {\\\0} f
  129.     set aind [lsearch -exact ${win::Active} $f]
  130.     if {$aind < 0} {error "No win '$f'"}
  131.     set rng [lrange ${win::Active} 0 [expr {$aind-1}]]
  132.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  133.     set f2 [lindex [lrange ${win::Active} end end] 0]
  134.     set win::Active [lreplace ${win::Active} end end]
  135.     set win::Active [linsert ${win::Active} 0 $f2]
  136.     regsub -all {\\([][])} $f2 {\1} f2
  137.     bringToFront $f2
  138. }
  139.  
  140. proc bufferOtherWindow {} {
  141.     global tileHeight tileTop tileWidth tileMargin
  142.     global numWinsToTile
  143.     set margin $tileMargin
  144.     set win [win::Current]
  145.     set numWins 2
  146.     set hor 2
  147.     set height [expr {($tileHeight/$numWins)-$margin}]
  148.     set height [expr {$height + $margin / $numWins}]
  149.     set width $tileWidth
  150.     set ver $tileTop
  151.     
  152.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  153.     set next [nextWin]
  154.     set res [statusPrompt "Window other half ($next): " winComp]
  155.     if {![string length $res]} {
  156.     set res $next
  157.     }
  158.     
  159.     set geo [getGeometry]
  160.     if {([lindex $geo 2] != $width) || ([lindex $geo 3] != $height) || ([lindex $geo 0] != $hor) || (([lindex $geo 1] != $ver) && ([lindex $geo 1] != [expr {$ver + $height + $margin}]))} {
  161.     moveWin $win 1000 0
  162.     sizeWin $win $width $height
  163.     moveWin $win $hor $ver
  164.     incr ver [expr {$height + $margin}]
  165.     } else {
  166.     if {[lindex $geo 1] == $ver} {
  167.         incr ver [expr {$height + $margin}]
  168.     } 
  169.     }
  170.     
  171.     set geo [getGeometry $res]
  172.     if {([lindex $geo 0] != $hor) || ([lindex $geo 1] != $ver) || ([lindex $geo 2] != $width) || ([lindex $geo 3] != $height)} {
  173.     moveWin $res 1000 0
  174.     sizeWin $res $width $height
  175.     moveWin $res $hor $ver
  176.     }
  177.     bringToFront $res
  178. }
  179.  
  180.         
  181.     
  182.         
  183.  
  184. proc winvertically {} {
  185.     global tileHeight tileTop tileWidth tileMargin
  186.     global numWinsToTile defWidth tileLeft
  187.     set margin $tileMargin
  188.     set names [winNames -f]
  189.     set numWins [llength $names]
  190.     if {$numWins<=1} return
  191.     if {$numWins>$numWinsToTile} {set numWins $numWinsToTile}
  192.     if {$numWins == 0} {return}
  193.     set height [expr {($tileHeight/$numWins)-$margin}]
  194.     set height [expr {$height + $margin / $numWins}]
  195.     set width $defWidth
  196.     set ver $tileTop
  197.     for {set i 0} {$i < $numWins} {incr i} {
  198.     sizeWin [lindex $names $i] $width $height
  199.     moveWin [lindex $names $i] $tileLeft $ver
  200.     set ver [expr {$ver+$margin+$height}]
  201.     }
  202. }
  203.  
  204. proc winhorizontally {} {
  205.     global tileHeight tileLeft tileWidth tileTop numWinsToTile horMargin
  206.     set names [winNames -f]
  207.     set numWins [llength $names]
  208.     if {$numWins<=1} return
  209.     if {$numWins>$numWinsToTile} {set numWins $numWinsToTile}
  210.     if {$numWins == 0} {return}
  211.     set width [expr {($tileWidth/$numWins)-$horMargin}]
  212.     set width [expr {$width + $horMargin / $numWins}]
  213.     set height $tileHeight
  214.     set hor $tileLeft
  215.     for {set i 0} {$i < $numWins} {incr i} {
  216.     sizeWin [lindex $names $i] $width $height
  217.     moveWin [lindex $names $i] $hor $tileTop
  218.     set hor [expr {$hor+$width+$horMargin}]
  219.     }
  220. }
  221.  
  222.  
  223. proc winunequalHor {} {
  224.     global tileLeft tileHeight tileWidth tileTop numWinsToTile horMargin
  225.     global tileProportion
  226.     set names [winNames -f]
  227.     sizeWin [lindex $names 0] \
  228.       [expr {$tileProportion*$tileWidth - $horMargin/2}] $tileHeight
  229.     moveWin [lindex $names 0] $tileLeft $tileTop
  230.     sizeWin [lindex $names 1] \
  231.       [expr {(1-$tileProportion)*$tileWidth - $horMargin/2}] $tileHeight
  232.     moveWin [lindex $names 1] \
  233.       [expr {$tileLeft + $tileProportion*$tileWidth + $horMargin/2}] $tileTop
  234. }
  235.  
  236.  
  237. proc winunequalVert {} {
  238.     global tileLeft tileMargin tileHeight tileWidth tileTop numWinsToTile
  239.     global horMargin tileProportion defWidth
  240.     set names [winNames -f]
  241.     set height [expr {$tileHeight + $tileMargin}]
  242.     sizeWin [lindex $names 0] \
  243.       $defWidth [expr {$tileProportion*$height - $tileMargin}]
  244.     moveWin [lindex $names 0] $tileLeft $tileTop
  245.     sizeWin [lindex $names 1] \
  246.       $defWidth [expr {(1-$tileProportion)*$height - $tileMargin}]
  247.     moveWin [lindex $names 1] \
  248.       $tileLeft [expr {$tileTop + $tileProportion*$height}]
  249. }
  250.  
  251.  
  252. proc wintiled {} {
  253.     global tileHeight tileWidth numWinsToTile tileTop
  254.     set xPan 8
  255.     set yPan 10
  256.     set xMarg 2
  257.     set yMarg $tileTop
  258.     set yMax 50
  259.     set names [winNames -f]
  260.     set numWins [llength $names]
  261.     if {$numWins<1} return
  262.     set line 0    
  263.     set height [expr {$tileHeight-$yPan*($numWins-1)}]
  264.     set width [expr {$tileWidth-$xPan*($numWins-1)}]
  265.     
  266.     for {set i 0} {$i < $numWins} {incr i} {
  267.     moveWin [lindex $names $i] [expr {$xMarg+$i*$xPan}] [expr {$yMarg+$line}]
  268.     set line [expr {$line+$yPan}]
  269.     if {$line>$yMax} {set line 0}
  270.     sizeWin [lindex $names $i] $width $height
  271.     }
  272. }
  273.  
  274.  
  275. proc winoverlay {} {
  276.     global defHeight defWidth numWinsToTile tileTop
  277.     set names [winNames -f]
  278.     set numWins [llength $names]
  279.     if {$numWins<1} return
  280.     for {set i 0} {$i < $numWins} {incr i} {
  281.     moveWin [lindex $names $i] 2 $tileTop
  282.     sizeWin [lindex $names $i] $defWidth $defHeight
  283.     }
  284. }
  285.  
  286.  
  287. proc chooseAWindow {} {
  288.     set name [listpick [lsort -ignore [winNames]]]
  289.     if {[string length $name]} {
  290.     bringToFront $name
  291.     if {[icon -q]} { icon -f $name -o }
  292.     }
  293. }
  294.  
  295.  
  296. proc nextWin {} {
  297.     global win::Active 
  298.     set files [winNames -f]
  299.     if {[llength $files] < 2} {return ""}
  300.     set f [lindex $files 0]
  301.     set aind [lsearch ${win::Active} $f]
  302.     if {$aind < 0} {error "No win '$f'"}
  303.     if {[incr aind] < [llength ${win::Active}]} {
  304.     return [file tail [lindex ${win::Active} $aind]]
  305.     } else {
  306.     return [file tail [lindex ${win::Active} 0]]
  307.     }
  308. }
  309.  
  310. proc winComp {curr c} {
  311.     if {$c != "\t"} {return $c}
  312.     
  313.     set matches {}
  314.     foreach w [winNames] {
  315.     if {[string match "$curr*" $w]} {
  316.         lappend matches $w
  317.     }
  318.     }
  319.     if {![llength $matches]} {
  320.     beep
  321.     } else {
  322.     return [string range [largestPrefix $matches] [string length $curr] end]
  323.     }
  324.     return ""
  325. }
  326.  
  327. proc killWindowStatus {} {
  328.     if {![llength [winNames]]} return
  329.     
  330.     set def [win::CurrentTail]
  331.     set res [statusPrompt "Kill window ($def): " winComp]
  332.     
  333.     if {[string length $res]} {
  334.     catch {bringToFront $res; killWindow}
  335.     } else {killWindow}
  336. }
  337.  
  338. proc chooseWindowStatus {} {
  339.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  340.     set next [nextWin]
  341.     set res [statusPrompt "Window ($next): " winComp]
  342.     if {[string length $res]} {
  343.     catch {bringToFront $res}
  344.     } else {
  345.     catch {bringToFront $next}
  346.     }
  347. }
  348.  
  349. proc iconify {} { 
  350.     icon -t 
  351.     if {[icon -q]} {
  352.     nextWindow
  353.     }
  354. }
  355.  
  356. proc zoom {} {
  357.     global nzmState tileHeight tileWidth zoomedGeo tileTop tileLeft
  358.     
  359.     set win [win::Current]
  360.     if {[info exists nzmState($win)]} {
  361.     if {[getGeometry] == $zoomedGeo} {
  362.         set state $nzmState($win)
  363.         moveWin [lindex $state 0] [lindex $state 1]
  364.         sizeWin [lindex $state 2] [lindex $state 3]
  365.         unset nzmState($win)
  366.         return
  367.     }
  368.     } 
  369.     
  370.     set nzmState($win) [getGeometry]
  371.     moveWin $tileLeft $tileTop
  372.     sizeWin $tileWidth $tileHeight
  373.     
  374.     if {![info exists zoomedGeo]} {
  375.     set zoomedGeo [getGeometry]
  376.     }
  377. }
  378.  
  379. #================================================================================
  380.  
  381. proc otherThing {} {
  382.     set win [win::Current]
  383.     getWinInfo -w $win arr
  384.     if {$arr(split)} {
  385.     otherPane
  386.     } else {
  387.     swapWithNext
  388.     }
  389. }
  390.  
  391. proc winAttribute {att {win {}}} {
  392.     if {![string length $win]} {
  393.     set win [win::Current]
  394.     }
  395.     getWinInfo -w $win arr
  396.     return $arr($att)
  397. }
  398.  
  399. proc floatName {str} {
  400.     if {[string match "•*" $str]} {
  401.     foreach n [info globals {*Menu}] {
  402.         global $n
  403.         if {![catch {set $n}] && ([set $n] == $str)} {
  404.         regexp {(.*)Menu} $n dummy name
  405.         return "[string toup [string index $name 0]][string range $name 1 end]"
  406.         }
  407.     }
  408.     }
  409.     return "[string toup [string index $str 0]][string range $str 1 end]"
  410. }
  411. proc winDirty {} {
  412.     getWinInfo arr
  413.     return $arr(dirty)
  414. }
  415.  
  416. proc winReadOnly {{win ""}} {
  417.     goto [minPos]
  418.     if {$win == ""} {set win [win::Current]}
  419.     setWinInfo -w $win dirty 0
  420.     setWinInfo -w $win read-only 1
  421. }
  422.  
  423. proc stripNameCount str {
  424.     regsub { <[0-9]+>} $str {} str
  425.     return $str
  426. }
  427.  
  428. proc shrinkWindow {{shrinkWidth 0}} {
  429.     global defHeight defWidth
  430.     # These constants work for 9-pt Monaco type
  431.     set lineht 11
  432.     set htoff 22
  433.     set chwd 6
  434.     set choff 20
  435.     
  436.     set wd [lindex [getGeometry] 2]
  437.     set ht [lindex [getGeometry] 3]
  438.     set top [lindex [getGeometry] 1]
  439.     set left [lindex [getGeometry] 0]
  440.     
  441.     set mxht [expr {[lindex [getMainDevice] 3] - $top - 5 -15}]
  442.     set mxwd [expr {[lindex [getMainDevice] 2] - $left - 5}]
  443.     set mnht 120
  444.     set mnwd 200
  445.     
  446.     set htWd [fileHtWd $shrinkWidth]
  447.     set lines [lindex $htWd 0]
  448.     set chars [lindex $htWd 1]
  449.     
  450.     if {$lines <= 1} {set lines 10}
  451.     
  452.     
  453.     if {$lines > 0} {
  454.     set ht [expr {$htoff + ( $lineht * (1 + $lines)) }]
  455.     } elseif {$ht > $defHeight} {
  456.     set ht $defHeight
  457.     }
  458.     
  459.     if {$chars > 0} {
  460.     set wd [expr {$choff + ( $chwd * (2 + $chars)) }]
  461.     } elseif {$wd > $defWidth} {
  462.     set wd $defWidth
  463.     }
  464.     
  465.     if {$ht > $mxht} {set ht $mxht}
  466.     if {$wd > $mxwd} {set wd $mxwd}
  467.     if {$ht < $mnht} {set ht $mnht}
  468.     if {$wd < $mnwd} {set wd $mnwd}
  469.     sizeWin $wd $ht
  470. }
  471.  
  472. #############################################################################
  473. # Return the number of lines and the maximum number of characters in any 
  474. # line of a file.  It would be nice if there was a built-in command to
  475. # do this (i.e., compiled C code) because this is a pretty slow way to
  476. # get the maximum line width.
  477.  
  478. proc fileHtWd {{checkWidth 0}} {
  479.     set text [getText [minPos] [maxPos]] 
  480.     getWinInfo arr
  481.     set tabw [expr {$arr(tabsize) - 1}]
  482.     
  483.     set lines [split $text "\r\n"]
  484.     set nlines [llength $lines]
  485.     
  486.     if {$checkWidth > 1} {
  487.     set lines [eval lrange \$lines [displayedLines]]
  488.     }
  489.     
  490.     set llen 0
  491.     if {$checkWidth > 0} {
  492.     foreach line $lines {
  493.         regsub {                +∞.*$} $line {} line
  494.         regsub {    } $line {    } line
  495.         set len [string length $line]
  496.         if {[set ntab [llength [split $line "\t"]]] > 1} {
  497.         set len [expr {$len + $tabw*($ntab-1)}]
  498.         }
  499.         if { $len > $llen} {
  500.         set llen $len
  501.         }
  502.     }
  503.     }
  504.     #    alertnote "Text Height : $nlines ; Text Width : $llen "
  505.     return [list $nlines $llen]
  506. }
  507.  
  508. # Report what range of lines are displayed in any window.
  509. # (A side effect is that the insertion point is moved to the 
  510. # top of the window, if it was previously off-screen)
  511. #
  512. proc displayedLines {{window {}}} {
  513.     if {$window == {}} { set window [win::Current] }
  514.     
  515.     bringToFront $window
  516.     set oldPos [getPos]
  517.     moveInsertionHere
  518.     set top [getPos]
  519.     set first [lindex [posToRowCol $top] 0]
  520.     moveInsertionHere -last
  521.     set bottom [getPos]
  522.     set last [lindex [posToRowCol $bottom] 0]
  523.     
  524.     if {$oldPos < $top || $oldPos > $bottom} {
  525.     goto $top
  526.     } else {
  527.     goto $oldPos
  528.     }
  529.     
  530.     return [list $first $last]
  531. }
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.