File: TtkDialog.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (79 lines) | stat: -rw-r--r-- 2,354 bytes parent folder | download | duplicates (4)
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
# TtkDialog.tcl --
# 
#       Use fsdialog on unix to replace the standard ugly ones.
#
#  Copyright (c) 2007 Mats Bengtsson
#  
#   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 3 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, see <http://www.gnu.org/licenses/>.
#  
#  $Id: TtkDialog.tcl,v 1.10 2008-04-27 06:50:15 matben Exp $

namespace eval ::TtkDialog {
    
    # X11 only!
    if {[tk windowingsystem] ne "x11"} {
	return
    }
    if {[catch {package require ui::dialog}]} {
	return
    }

    variable scriptDir [file dirname [info script]]
    set fsdialog [file join $scriptDir fsdialog.tcl]
    if {![file exists $fsdialog]} {
	return
    }
    component::define TtkDialog "User friendly file selection dialogs"
}

proc ::TtkDialog::Init {} {
    variable scriptDir
    
    set fsdialog [file join $scriptDir fsdialog.tcl]
    if {![file exists $fsdialog]} {
	return
    }
    uplevel #0 [list source $fsdialog]
    component::register TtkDialog

    interp alias {} tk_getOpenFile     {} ttk::getOpenFile
    interp alias {} tk_getSaveFile     {} ttk::getSaveFile
    interp alias {} tk_chooseDirectory {} ttk::chooseDirectory
    interp alias {} tk_messageBox      {} ::TtkDialog::MessageBox

    # Message catalog.
    set msgdir [file join $::this(msgcatCompPath) TtkDialog]
    if {[file isdirectory $msgdir]} {
	uplevel #0 [list ::msgcat::mcload $msgdir]
    }
}

proc ::TtkDialog::MessageBox {args} {
    variable button
    
    # @@@ Some of this should probably be in ui::dialog
    set argsA(-parent) .
    array set argsA $args
    set argsA(-variable) [namespace current]::button
    set argsA(-modal) 1
    set w [eval {ui::dialog} [array get argsA]]
    ::tk::PlaceWindow $w widget $argsA(-parent)

    catch {grab $w}
    vwait [namespace current]::button
    grab release $w

    return $button
}