File: Bookmarks.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (294 lines) | stat: -rw-r--r-- 7,608 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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
#  Bookmarks.tcl ---
#  
#      This file is part of The Coccinella application. 
#      It implements a bookmarks dialog.
#      
#      @@@ Perhaps this could be made general enogh to be placed in ui/
#      
#  Copyright (c) 2005  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: Bookmarks.tcl,v 1.9 2007-09-14 08:11:45 matben Exp $

package require snit 1.0
package require ui::util

package provide Bookmarks 1.0

namespace eval ::Bookmarks {

    set title [mc "Edit Bookmarks"]	
    option add *Bookmarks.title         $title      widgetDefault
}

# Bookmarks::Dialog --
#
#       Megawidget bookmarks dialog.

snit::widget ::Bookmarks::Dialog {
    hulltype toplevel
    widgetclass Bookmarks
    
    # @@@ works only on macs!!!
    # -menu must be done only on creation, else crash on mac.
    delegate option -menu to hull
    
    variable bookmarksVar {}
    variable tmpList
    variable boolColumns {}
    variable boolVar
    variable rowuid 0
    variable wtablelist
    variable wnew
    variable wsave
    variable wrun

    option -command      -default ::Bookmarks::Nop
    option -geovariable
    option -title -configuremethod OnConfigTitle
    option -columns     -default {0 Bookmark 0 Address}
    option -editable    -default {}
    
    constructor {_bookmarksVar args} {
	$self configurelist $args
	set bookmarksVar $_bookmarksVar
		
	# Operate on a temporary list.
	if {[uplevel #0 {info exists bookmarksVar}]} {
	    set tmpList [uplevel #0 [list set $bookmarksVar]]
	} else {
	    set tmpList [list]
	}	
	if {[tk windowingsystem] ne "aqua"} {
	    $win configure -menu ""
	}
	wm title $win $options(-title)

	# Global frame.
	set wbox $win.f
	ttk::frame $wbox -padding [option get . dialogPadding {}]
	pack $wbox -fill both -expand 1

	frame $wbox.fb -bd 1 -relief sunken
	set wfb $wbox.fb
	set wsc $wfb.s
	set wtb $wfb.t
	set wtablelist $wtb
	
	ttk::scrollbar $wsc -orient vertical -command [list $wtb yview]
	tablelist::tablelist $wtb -columns $options(-columns)  \
	  -listvariable [myvar tmpList] -stretch all           \
	  -yscrollcommand [list $wsc set] -width 48 -bd 0
	
	# Make all columns editable by default.
	if {[llength $options(-editable)]} {
	    foreach c $options(-editable) {
		$wtb columnconfigure $c -editable 1
	    }
	} else {
	    set ncol [$wtb columncount]
	    for {set c 0} {$c < $ncol} {incr c} {
		$wtb columnconfigure $c -editable 1
	    }
	}
	set rowCount [$wtb size]
	for {set row 0} {$row < $rowCount} {incr row} {
	    $wtb rowconfigure $row -name [incr rowuid]
	    $self BooleanColumnsForRow $row
	}
	
	grid  $wtb  -column 0 -row 0 -sticky news
	grid  $wsc  -column 1 -row 0 -sticky ns
	grid columnconfigure $wfb 0 -weight 1
	grid rowconfigure    $wfb 0 -weight 1
	
	pack $wfb -fill both -expand 1
	
	# Button part.
	set bot $wbox.b
	ttk::frame $bot -padding [option get . okcancelTopPadding {}]
	ttk::button $bot.save -text [mc "Save"] -default active  \
	  -command [list $self Save]
	::chasearrows::chasearrows $bot.run -size 16
	ttk::button $bot.cancel -text [mc "Cancel"]  \
	  -command [list $self Destroy]
	ttk::button $bot.new -text [mc "New Bookmark"]  \
	  -command [list $self New]
	ttk::button $bot.del -text [mc "Delete"]  \
	  -command [list $self Delete]
	set padx [option get . buttonPadX {}]
	if {[option get . okcancelButtonOrder {}] eq "cancelok"} {
	    pack $bot.save   -side right
	    pack $bot.cancel -side right -padx $padx
	} else {
	    pack $bot.cancel -side right
	    pack $bot.save   -side right -padx $padx
	}
	pack $bot.new -side left
	pack $bot.del -side left
	pack $bot.run -side left -padx 8
	pack $bot -side bottom -fill x
	
	set wsave $bot.save
	set wnew  $bot.new
	set wrun  $bot.run
	
	if {[string length $options(-geovariable)]} {
	    ui::SetClassGeometry $win $options(-geovariable) "Bookmarks"
	}

	set tag [$wtb bodytag]
	bind $win <Return> [list $self Save]
	bind $win <Escape> [list $self Cancel]
	bind $tag <BackSpace> [list $self Delete]

	return
    }
    
    destructor {
	if {[string length $options(-geovariable)]} {
	    ui::SaveGeometry $win $options(-geovariable)
	}
    }
    
    method OnConfigTitle {option value} {
	wm title $win $value
	set options($option) $value
    }
    
    method New {} {
	set line [list [mc "New Bookmark"]]
	set ncol [$wtablelist columncount]
	for {set i 1} {$i < $ncol} {incr i} {
	    lappend line {}
	}
	lappend tmpList $line
	$wtablelist rowconfigure end -name [incr rowuid]
	$wtablelist editcell end,0
	$self BooleanColumnsForRow end
    }
    
    method Delete {} {
	set items [$wtablelist curselection]
	foreach item [lsort -integer -decreasing $items] {
	    $wtablelist delete $item	
	}
    }
        
    method BooleanColumnsForRow {row} {
	foreach c $boolColumns {
	    $wtablelist cellconfigure $row,$c  \
	      -window [list $self MakeCheckbutton]
	}
    }
    
    method SetCheckbuttonForRow {row} {
	set name [$wtablelist rowcget $row -name]
	foreach col $boolColumns {
	    set boolVar($name,$col) [lindex $tmpList $row $col]
	    lset tmpList $row $col ""
	    $wtablelist cellconfigure $row,$col -editable 0
	}	    
    }

    method MakeCheckbutton {tbl row col w} {
	set name [$wtablelist rowcget $row -name]
	checkbutton $w -highlightthickness 0 -padx 0 -pady 0 -bg white  \
	  -variable [myvar boolVar($name,$col)]
    }
	
    method Save {} {
	$wtablelist finishediting
	
	# Need to do it this way to get the boolean variables.
	set tmp {}
	set size [$wtablelist size]
	for {set row 0} {$row < $size} {incr row} {
	    lappend tmp [$wtablelist get $row]
	    set name [$wtablelist rowcget $row -name]
	    foreach col $boolColumns {
		lset tmp $row $col $boolVar($name,$col)
	    }
	}
	
	uplevel #0 [list set $bookmarksVar $tmp]

	if {$options(-command) ne ""} {
	    set rc [catch {$options(-command)} result]
	    if {$rc == 1} {
		return -code $rc -errorinfo $::errorInfo -errorcode $::errorCode $result
	    } elseif {$rc == 3 || $rc == 4} {
		return
	    } 
	}
	$self Destroy
    }
    
    method Destroy {} {
	if {[string length $options(-geovariable)]} {
	    ui::SaveGeometry $win $options(-geovariable)
	}
	destroy $win
    }
    
    # Public methods:

    method add {row} {
	lappend tmpList $row
	$wtablelist rowconfigure end -name [incr rowuid]
	set ridx [expr {[llength $tmpList]-1}]
	if {[llength $boolColumns]} {
	    $self BooleanColumnsForRow $ridx
	    $self SetCheckbuttonForRow $ridx
	}
    }
    
    method state {state} {
	$wsave state $state
	$wnew  state $state
	if {[lsearch $state "disabled"] >= 0} {
	    #$wtablelist
	} else {
	    
	}
    }
    
    method boolean {column} {
	lappend boolColumns $column
    }
    
    method wait {{bool 1}} {
	if {$bool} {
	    $wrun start
	} else {
	    $wrun stop
	}
    }

    method grab {} {
	ui::Grab $win
    }
}

proc ::Bookmarks::Nop {args} {}

if {0} {
    ::Bookmarks::Dialog .bm ::var -columns {0 A 0 B 0 C}
    .bm boolean 2
    .bm add {111 111 0}
    .bm add {222 222 1} 
    .bm add {333 333 0}
}