File: dialog.tcl

package info (click to toggle)
dotfile 1%3A2.4-1
  • links: PTS
  • area: main
  • in suites: potato
  • size: 5,472 kB
  • ctags: 523
  • sloc: tcl: 14,072; sh: 918; makefile: 177; lisp: 18; ansic: 7
file content (97 lines) | stat: -rw-r--r-- 3,285 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

### This file is based on dialog.tcl from the standard Tk4.0 distribution.
proc tk_dialog {w title text bitmap default args} {
  global tkPriv

  # 1. Create the top-level window and divide it into top
  # and bottom parts.

  catch {destroy $w}
  toplevel $w -class Dialog
  wm title $w $title
  wm iconname $w Dialog
  wm protocol $w WM_DELETE_WINDOW { }
  wm transient $w [winfo toplevel [winfo parent $w]]
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  # 2. Fill the top part with bitmap and message.

  label $w.msg -wraplength 3i -justify left -text $text \
      -font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
  pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  if {$bitmap != ""} {
    label $w.bitmap -bitmap $bitmap
    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  }

  # 3. Create a row of buttons at the bottom of the dialog.

  set i 0
  foreach but $args {
    button $w.button$i -text $but -command "set tkPriv(button) $i"
    if {$i == $default} {
      frame $w.default -relief sunken -bd 1
      raise $w.button$i $w.default
      pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
      pack $w.button$i -in $w.default -padx 2m -pady 2m
      bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
    } else {
      pack $w.button$i -in $w.bot -side left -expand 1 \
	  -padx 3m -pady 2m
    }
    incr i
  }

  # 4. Withdraw the window, then update all the geometry information
  # so we know how big it wants to be, then center the window in the
  # display and de-iconify it.

  wm withdraw $w
  update idletasks
  set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	     - [winfo vrootx [winfo parent $w]]]
  set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	     - [winfo vrooty [winfo parent $w]]]
  wm geom $w +$x+$y
  wm deiconify $w

  # 5. Set a grab and claim the focus too.

  set oldFocus [focus]
  set count 0
  pushGrab local $w
  tkwait visibility $w
  if {$default >= 0} {
    focus $w.button$default
  } else {
    focus $w
  }

  # 6. Wait for the user to respond, then restore the focus and
  # return the index of the selected button.  Restore the focus
  # before deleting the window, since otherwise the window manager
  # may take the focus away so we can't redirect it.

  tkwait variable tkPriv(button)
  catch {focus $oldFocus}
  catch "destroy $w"
  popGrab
  return $tkPriv(button)
}