home *** CD-ROM | disk | FTP | other *** search
/ Freesoft 1999 February / Freesoft_1999-02_cd.bin / Recenz / Utility / DisplayDoctorLinux / scitech-display-doctor-1.0beta-3.i386.rpm / scitech-display-doctor-1.0beta.3.cpio.gz / scitech-display-doctor-1.0beta.3.cpio / usr / lib / nucleus / XF86Setup / tcllib / tearoff.tcl < prev    next >
Text File  |  1998-09-19  |  4KB  |  129 lines
  1. # $XConsortium: tearoff.tcl /main/1 1996/09/21 14:16:12 kaleb $
  2. #
  3. #
  4. #
  5. #
  6. # $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/tearoff.tcl,v 3.1 1996/12/27 06:55:07 dawes Exp $
  7. #
  8. # tearoff.tcl --
  9. #
  10. # This file contains procedures that implement tear-off menus.
  11. #
  12. # @(#) tearoff.tcl 1.5 95/04/23 16:50:06
  13. #
  14. # Copyright (c) 1994 The Regents of the University of California.
  15. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  16. #
  17. # See the file "license.terms" for information on usage and redistribution
  18. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  19. #
  20.  
  21. # tkTearoffMenu --
  22. # Given the name of a menu, this procedure creates a torn-off menu
  23. # that is identical to the given menu (including nested submenus).
  24. # The new torn-off menu exists as a toplevel window managed by the
  25. # window manager.  The return value is the name of the new menu.
  26. #
  27. # Arguments:
  28. # w -            The menu to be torn-off (duplicated).
  29.  
  30. proc tkTearOffMenu w {
  31.     # Find a unique name to use for the torn-off menu.  Find the first
  32.     # ancestor of w that is a toplevel but not a menu, and use this as
  33.     # the parent of the new menu.  This guarantees that the torn off
  34.     # menu will be on the same screen as the original menu.  By making
  35.     # it a child of the ancestor, rather than a child of the menu, it
  36.     # can continue to live even if the menu is deleted;  it will go
  37.     # away when the toplevel goes away.
  38.  
  39.     set parent [winfo parent $w]
  40.     while {([winfo toplevel $parent] != $parent)
  41.         || ([winfo class $parent] == "Menu")} {
  42.     set parent [winfo parent $parent]
  43.     }
  44.     if {$parent == "."} {
  45.     set parent ""
  46.     }
  47.     for {set i 1} 1 {incr i} {
  48.     set menu $parent.tearoff$i
  49.     if ![winfo exists $menu] {
  50.         break
  51.     }
  52.     }
  53.  
  54.     tkMenuDup $w $menu
  55.     wm overrideredirect $menu 0
  56.  
  57.     # Pick a title for the new menu by looking at the parent of the
  58.     # original: if the parent is a menu, then use the text of the active
  59.     # entry.  If it's a menubutton then use its text.
  60.  
  61.     set parent [winfo parent $w]
  62.     switch [winfo class $parent] {
  63.     Menubutton {
  64.         wm title $menu [$parent cget -text]
  65.     }
  66.     Menu {
  67.         wm title $menu [$parent entrycget active -label]
  68.     }
  69.     }
  70.  
  71.     $menu configure -tearoff 0
  72.     $menu post [winfo x $w] [winfo y $w]
  73.  
  74.     # Set tkPriv(focus) on entry:  otherwise the focus will get lost
  75.     # after keyboard invocation of a sub-menu (it will stay on the
  76.     # submenu).
  77.  
  78.     bind $menu <Enter> {
  79.     set tkPriv(focus) %W
  80.     }
  81. }
  82.  
  83. # tkMenuDup --
  84. # Given a menu (hierarchy), create a duplicate menu (hierarchy)
  85. # in a given window.
  86. #
  87. # Arguments:
  88. # src -            Source window.  Must be a menu.  It and its
  89. #            menu descendants will be duplicated at dst.
  90. # dst -            Name to use for topmost menu in duplicate
  91. #            hierarchy.
  92.  
  93. proc tkMenuDup {src dst} {
  94.     set cmd "menu $dst"
  95.     foreach option [$src configure] {
  96.     if {[llength $option] == 2} {
  97.         continue
  98.     }
  99.     lappend cmd [lindex $option 0] [lindex $option 4]
  100.     }
  101.     eval $cmd
  102.     set last [$src index last]
  103.     if {$last == "none"} {
  104.     return
  105.     }
  106.     for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
  107.     set cmd "$dst add [$src type $i]"
  108.     foreach option [$src entryconfigure $i]  {
  109.         lappend cmd [lindex $option 0] [lindex $option 4]
  110.     }
  111.     eval $cmd
  112.     if {[$src type $i] == "cascade"} {
  113.         tkMenuDup [$src entrycget $i -menu] $dst.m$i
  114.         $dst entryconfigure $i -menu $dst.m$i
  115.     }
  116.     }
  117.  
  118.     # Duplicate the binding tags and bindings from the source menu.
  119.  
  120.     regsub -all . $src {\\&} quotedSrc
  121.     regsub -all . $dst {\\&} quotedDst
  122.     regsub -all $quotedSrc [bindtags $src] $dst x
  123.     bindtags $dst $x
  124.     foreach event [bind $src] {
  125.     regsub -all $quotedSrc [bind $src $event] $dst x
  126.     bind $dst $event $x
  127.     }
  128. }
  129.