megawidget framework with tclOO (1)
FM This is another megawidget framework.
It uses the typedlist package. It's a class which creates a megawidget as an ensemble command.
There is a two examples below.
- The first one is an editor (unfinished) with tabs, unicode chars, toolbar, and searchbox.
It should look like this :
- The second one is listbox-like pseudowidget, with image and text, and a filter capabilities.
Here's a screen shot of its possible use :
man page
package code :
package require Tk
package require tkpath
package require Tktable
package require typedlist
oo::class create megawidget {
variable path
variable myOptions
variable WidgetTree
variable rootPath
variable returnCommand
constructor {tree} {
my variable WidgetTree
my variable instance
my variable OptionListe
my variable returnCommand
set returnCommand {}
set instance 0
set OptionListe [list widget mwidget wOptions myOption bScripts \
handler hMethods hVars hVal hPostConfig\
gmPack gmNotebook gmPane gmText gmCanvas gmTable \
gmGrid \
CanvasItem TkpItem spanTable textIsPeer scTable default \
top geometry title attributes resizable minsize maxsize \
overrideredirect protocol howToReturn]
::set WidgetTree(script) $tree
foreach o [list {*}$OptionListe < > ^ v @] {
typedlist create $o
}
}
method getTreeScript {} {
my variable WidgetTree
my variable instance
return $WidgetTree(script)
}
method setTreeScript {script} {
my variable WidgetTree
set WidgetTree(script) $script
}
method getTree {} {
my variable WidgetTree
my variable instance
return $WidgetTree(tree)
}
method lappendPostConfig {post} {
my variable instance
variable rootPath
lappend ::${rootPath}::hPostConfig $post
return
}
method getPostConfig {} {
my variable instance
variable rootPath
if {[info exist ::${rootPath}::hPostConfig]} {
return [set ::${rootPath}::hPostConfig]
} else {
return
}
}
method getOptions {args} {
my variable myOptions
my variable instance
set e [lindex $args 0]
if {(![catch {info object class $e}]) && ([info object class $e] eq "::typedlist") && ([$e type] eq "default")} {
set default [$e get]
set args [lassign $args dummy]
} else {
set default []
}
if {[dict exist $myOptions {*}$args]} {
return [dict get $myOptions {*}$args]
} else {
return $default
}
}
method createHandler {handler path {typeHandler meta}} {
variable rootPath
my variable instance
# Déterminer si le raccourci pointe une métafenêtre ?
# Cela a-t-il du sens qu'elle n'en soit pas une ? En théorie, oui.
# Par exemple, un ajout d'une série de fenêtre à un endroit précis.
namespace eval ::${rootPath}::$handler {}
namespace eval ::${rootPath}::get::$path {}
proc ::${rootPath}::${handler}::path {} "return ${path}_"
proc ::${rootPath}::${handler}::obj {args} [subst {
if {\$args eq {}} {
return [list ${path}]
} else {
[list $path] {*}\$args
}
}]
proc ::${rootPath}::${handler}::configure {args} "[list ${path}_] configure {*}\$args"
proc ::${rootPath}::${handler}::do {args} "[list ${path}_] {*}\$args"
proc ::${rootPath}::${handler}::bind {event script} [subst {
::bind [list ${path}_] \$event \$script
}]
proc ::${rootPath}::${handler}::parent {args} [subst {
return \[winfo parent [list ${path}_]]
}]
proc ::${rootPath}::${handler}::brother {args} [subst {
return \[winfo children \[winfo parent [list ${path}_]]]
}]
proc ::${rootPath}::get::${path}::handler {args} [subst {
return [list $handler]
}]
proc ::${rootPath}::${handler}::space {args} [subst {
return [list ::${rootPath}::${handler}]
}]
namespace eval ::${rootPath}::$handler namespace export *
namespace eval ::${rootPath}::$handler namespace ensemble create
namespace eval ::${rootPath}::get::$path namespace export *
namespace eval ::${rootPath}::get::$path namespace ensemble create
namespace eval ::${rootPath} namespace export *
namespace eval ::${rootPath} namespace ensemble create
lappend ::${rootPath}::get::Handlers $handler
lappend ::${rootPath}::get::Objects $handler
lappend ::${rootPath}::get::mwidgets $path
return $handler
}
method getSpace {} {
return [self namespace]
}
method unknown {w args} {
my variable myOptions
my variable instance
my variable WidgetTree
my variable howToReturn
my variable rootPath
if {[string match .* $w]} {
if {[winfo exist $w]} {
return -code error -message "$w already exist"
}
if {[winfo exist ${w}_]} {
return -code error -message "${w}_ already exist"
}
if {[string last . $w] == 0} {
# la fenêtre parente . existe toujours
if {$w ne "."} {
# ! créer un nouvel objet, sinon les données se confondent !
# pour (version 0,4), ou bien calculer l'instance si ce n'est pas possible (mais il faudra aussi la repérer)
incr instance
if {$instance > 1} {
# An object is already created; create a new one
set newObj [megawidget create [self]:$instance $WidgetTree(script)]
set res [$newObj $w {*}$args]
return $res
}
set myOptions $args
my _build $w
if {[set ::${rootPath}::returnCommand] ne {}} {
return [eval {*}[set ::${rootPath}::returnCommand]]
} else {
return $w
}
} else {
return -code error -message "$w is the toplevel window !"
}
} elseif {[set lastdot [string last . $w]] > 0} {
# la fenêtre parent doit exister
if {[set ParentWindow [winfo exist [string range $w 0 ${lastdot}-1]]]} {
incr instance
if {$instance > 1} {
# An object is already created; create a new one
set newObj [megawidget create [self]:$instance $WidgetTree(script)]
set res [$newObj $w {*}$args]
return $res
}
# Options
set myOptions $args
my _build $w
if {[set ::${rootPath}::returnCommand] ne {}} {
return [eval {*}[set ::${rootPath}::returnCommand]]
} else {
return $w
}
} else {
return -code error -message "window $ParentWindow doesn't exist"
}
}
} else {
return -code error -message "Bad widget path name $w"
}
}
method _build {w} {
my variable WidgetTree
variable path
variable rootPath
my variable instance
set rootPath $w
set path ${w}_
flush stdout
namespace eval ::${rootPath} [list namespace eval get [list]]
namespace eval ::${rootPath}::get [list variable Handlers []]
namespace eval ::${rootPath}::get [list variable Widgets []]
namespace eval ::${rootPath}::get [list variable MWidgets []]
namespace eval ::${rootPath}::get [list variable Objects []]
namespace eval ::${rootPath}::get [list variable Listes []]
set ::${rootPath}::hPostConfig []
set ::${rootPath}::returnCommand []
set Tree [regsub -all -- %MW $WidgetTree(script) [list ${rootPath}]]; # substitution MegaWidget
set Tree [regsub -all -- ***=%${rootPath} $Tree %MW]; # unsubstitute protected MegaWidget
set Tree [regsub -all -- %O $Tree [list [self]]]; # substitution Object
set Tree [regsub -all -- %[self] $Tree %O]; # unsubstitute protected Object
::set WidgetTree(tree) [my eval $Tree]
set tree [my makeToplevel $WidgetTree(tree)]
my make $tree
proc ::${rootPath}::rootpath {args} [subst {
return [list ${rootPath}_]
}]
proc ::${rootPath}::get::widgets {{pattern {*}}} {
variable Widgets
return [lsearch -inline -all $Widgets $pattern]
}
set S []
foreach o [list caller class filter method namespace next object target] {
catch {lappend S $o [self $o]}
}
proc ::${rootPath}::get::my {{option {}}} [subst {
if {\$option in {namespace caller class filter method namespace next object target}} {
return \[dict get [list $S] \$option]
}
}]
unset S
proc ::${rootPath}::get::mwidgets {{pattern {*}}} {
variable MWidgets
return [lsearch -inline -all $MWidgets $pattern]
}
proc ::${rootPath}::get::handlers {{pattern {*}}} {
variable Handlers
return [lsearch -inline -all $Handlers $pattern]
}
proc ::${rootPath}::get::objects {{pattern {*}}} {
variable Objects
return [lsearch -inline -all $Objects $pattern]
}
proc ::${rootPath}::get::typedlists {{pattern {*}}} {
variable Listes
return [lsearch -inline -all $Listes $pattern]
}
namespace eval ::${rootPath} namespace export *
namespace eval ::${rootPath} namespace ensemble create
namespace eval ::${rootPath}::get namespace export *
namespace eval ::${rootPath}::get namespace ensemble create
foreach e [my getPostConfig] {
if {[catch {
eval {*}$e
} err]} {
puts stderr [list megawidget get $err when evaluating $e in postconfiguration step]
}
}
}
method makeToplevel {tree} {
my variable WidgetTree
variable path
variable rootPath
my variable myOptions
my variable instance
my variable returnCommand
if {(![catch {info object class $tree}]) && ([info object class $tree] eq "::typedlist") \
&& ([$tree type] eq "top")} {
# create a new toplevel
lappend ::${rootPath}::get::Listes $tree
set i -1
set Top [toplevel $path]
set WidgetTree($path,wtype) "toplevel"
# A voir pour que la destruction soit complète
wm protocol $Top WM_DELETE_WINDOW [subst {
foreach l \[[list $rootPath] get typedlists\] {
if {\[catch {\$l destroy} err\]} {
puts stderr "erreur de destruction de la liste \$l
message: \$err, rootpath [list $rootPath]
dans la procédure megawidget makeToplevel, protocol WM_DELETE_WINDOW
"
}
}
namespace delete $rootPath
if {$instance > 1} {
# A voir
[self] destroy
}
destroy $Top
}]
foreach o [$tree get] {
if {(![catch {info object class $o}]) && ([info object class $o] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $o
switch -- [$o type] {
wOptions {
# Options de création de la fenêtre
$Top configure {*}[$o get]
} grid {
wm grid $Top {*}[$o get]
} title {
wm title $Top [$o get]
} resizeable {
wm resizeable $Top {*}[$o get]
} geometry {
wm geometry $Top [$o get]
} attributes {
foreach {attr val} [$o get] {
wm attributes $Top $attr $val
}
} protocol {
set script [lassign [$o get] p]
if {$p eq "WM_DELETE_WINDOW"} {
append script \n namespace\ delete\ $rootPath \n
append script destroy\ $Top
wm protocol $Top $p "eval $script"
}
} minsize {
lassign [$o get] W H
wm minsize $Top $W $H
} maxsize {
lassign [$o get] W H
wm maxsize $Top $W $H
} overrideredirect {
wm overrideredirect $Top [$o get]
} howToReturn {
# commande à retourner
set ::${rootPath}::returnCommand [$o get]
} > - < - v - ^ - @ {
return $o
}}
}
}
} else {
frame $path
return $tree
}
}
method make {tree} {
my variable WidgetTree
variable path
variable rootPath
variable myOptions
my variable OptionListe
set isWidgetCreated 0
lassign [lrepeat [llength $OptionListe] []] {*}$OptionListe
if {(![catch {info object class $tree}]) && ([info object class $tree] eq "::typedlist") \
&& ([$tree type] in {> < v ^ @})} {
set SIDE [dict get [dict create > left v top ^ bottom < right @ {}] [$tree type]]
set P $path
foreach e [$tree get] {
if {(![catch {info object class $e}]) && ([info object class $e] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $e
switch -- [$e type] {
mwidget {
lassign [lrepeat [llength $OptionListe] []] {*}$OptionListe
set mwCommand [lindex [$e get] 0]
set path ${path}.[regsub -all {::} [string tolower $mwCommand 0 0] {_}][incr id]
set WidgetTree($path,wtype) "mwidget"
set WidgetTree(${path}_,gm) Pack; #pack en valeur par défault
foreach o [lrange [$e get] 1 end] {
if {(![catch {info object class $o}]) && ([info object class $o] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $o
switch -- [$o type] {
wOptions {
set wOptions [$o get]
} gmPack {
set gmPack [$o get]
set WidgetTree(${path}_,gm) Pack
} gmGrid {
set gmGrid [$o get]
set WidgetTree(${path}_,gm) Grid
} gmNotebook {
set gmNotebook [$o get]
set WidgetTree(${path}_,gm) Notebook
set WidgetTree(${path},gm) Notebook
} gmTable {
set gmTable [$o get]
set WidgetTree(${path}_,gm) Table
set WidgetTree(${path},gm) Table
} gmPane {
set gmPane [$o get]
set WidgetTree(${path}_,gm) Panewindow
set WidgetTree(${path},gm) Panewindow
} gmCanvas {
set gmCanvas [$o get]
set WidgetTree(${path}_,gm) Canvas
set WidgetTree(${path},gm) Canvas
} gmText {
set gmText [$o get]
set WidgetTree(${path}_,gm) Text
set WidgetTree(${path},gm) Text
} handler {
set handler [lindex [$o get] 0]
lappend ::${rootPath}::get::Objects $handler
lappend ::${rootPath}::get::Handlers $handler
# création du raccourci
namespace eval ::${rootPath}::$handler {}
namespace eval ::${rootPath}::get::$path {}
proc ::${rootPath}::${handler}::path {} "return ${path}_"
proc ::${rootPath}::${handler}::obj {args} [subst {
if {\$args eq {}} {
return [list $path]
} else {
[list $path] {*}\$args
}
}]
proc ::${rootPath}::${handler}::configure {args} "[list ${path}_] configure {*}\$args"
proc ::${rootPath}::${handler}::do {args} "[list ${path}_] {*}\$args"
proc ::${rootPath}::${handler}::bind {event script} [subst {
::bind [list ${path}_] \$event \$script
}]
proc ::${rootPath}::${handler}::parent {args} [subst {
return \[winfo parent [list ${path}_]]
}]
proc ::${rootPath}::${handler}::brother {args} [subst {
return \[winfo children \[winfo parent [list ${path}_]]]
}]
proc ::${rootPath}::get::${path}::handler {args} [subst {
return [list $handler]
}]
proc ::${rootPath}::${handler}::space {args} [subst {
return [list ::${rootPath}::${handler}]
}]
foreach mv [lrange [$o get] 1 end] {
if {([info object class $mv] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $mv
if {[$mv type] eq "hMethods"} {
foreach {Name Args Body} [$mv get] {
proc ::${rootPath}::${handler}::$Name $Args $Body
}
} elseif {[$mv type] eq "hVars"} {
foreach v [$mv get] {
if {(![catch {info object class $v}]) \
&& ([info object class $v] eq "::typedlist")\
&& ([$v type] eq "hVal")} {
namespace eval ::${rootPath}::${handler} [list set $var $v]
} else {
namespace eval ::${rootPath}::${handler} [list variable [set var $v]]
}
}
} elseif {[$mv type] eq "hPostConfig"} {
# Un script à évaluer après création
# Création de tout ou bien juste du handler ? A voir ...
set hPC [$mv get]
my lappendPostConfig $hPC
} else {
# puts "unknown option"
}
} else {
continue
}
}
namespace eval ::${rootPath}::$handler namespace export *
namespace eval ::${rootPath}::$handler namespace ensemble create
namespace eval ::${rootPath}::get::$path namespace export *
namespace eval ::${rootPath}::get::$path namespace ensemble create
}}
}
}
set isWidgetCreated 0
} widget {
# widget command en 0
lassign [lrepeat [llength $OptionListe] []] {*}$OptionListe
set wCommand [lindex [$e get] 0]
set path ${path}.[regsub -all -- {::} $wCommand {_}][incr id]
set WidgetTree($path,wtype) "widget"
set WidgetTree($path,gm) Pack; #pack en valeur par défault
foreach o [lrange [$e get] 1 end] {
if {(![catch {info object class $o}]) && ([info object class $o] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $o
switch -- [$o type] {
wOptions {
set wOptions [$o get]
} gmPack {
set gmPack [$o get]
set WidgetTree($path,gm) Pack
} gmGrid {
set gmGrid [$o get]
set WidgetTree(${path},gm) Grid
} gmNotebook {
set gmNotebook [$o get]
set WidgetTree($path,gm) Notebook
} gmTable {
set gmTable [$o get]
set WidgetTree($path,gm) Table
} gmPane {
set gmPane [$o get]
set WidgetTree($path,gm) Panewindow
} gmCanvas {
set gmCanvas [$o get]
set WidgetTree($path,gm) Canvas
} gmText {
set gmText [$o get]
set WidgetTree($path,gm) Text
} textIsPeer {
set textIsPeer [$o get]
if {![info exist WidgetTree(peer,$textIsPeer)]} {
if {[winfo exist $textIsPeer]} {
# probablement un texte externe
set WidgetTree(peer,$path) $textIsPeer
set WidgetTree(peer,$textIsPeer) $textIsPeer
} else {
# première création : normal
set WidgetTree(peer,$textIsPeer) $path
}
} else {
set WidgetTree(peer,$path) $textIsPeer
}
} bScripts {
set bScripts []
foreach {bSeq bSc} [$o get] {
lappend bScripts $bSeq $bSc
}
} handler {
set handler [lindex [$o get] 0]
lappend ::${rootPath}::get::Handlers $handler
# création du raccourci
namespace eval ::${rootPath}::$handler {}
namespace eval ::${rootPath}::get::$path {}
proc ::${rootPath}::${handler}::path {} "return [list $path]"
proc ::${rootPath}::${handler}::configure {args} "[list $path] configure {*}\$args"
proc ::${rootPath}::${handler}::do {args} "[list $path] {*}\$args"
proc ::${rootPath}::${handler}::bind {event script} [subst {
::bind [list $path] \$event \$script
}]
proc ::${rootPath}::${handler}::parent {args} [subst {
return \[winfo parent [list $path]]
}]
proc ::${rootPath}::${handler}::brother {args} [subst {
return \[winfo children \[winfo parent [list $path]]]
}]
proc ::${rootPath}::get::${path}::handler {args} [subst {
return [list $handler]
}]
proc ::${rootPath}::${handler}::space {args} [subst {
return [list ::${rootPath}::${handler}]
}]
foreach mv [lrange [$o get] 1 end] {
if {([info object class $mv] eq "::typedlist")} {
lappend ::${rootPath}::get::Listes $mv
if {[$mv type] eq "hMethods"} {
foreach {Name Args Body} [$mv get] {
proc ::${rootPath}::${handler}::$Name $Args $Body
}
} elseif {[$mv type] eq "hVars"} {
foreach v [$mv get] {
if {(![catch {info object class $v}]) \
&& ([info object class $v] eq "::typedlist")\
&& ([$v type] eq "hVal")} {
lappend ::${rootPath}::get::Listes $v
namespace eval ::${rootPath}::${handler} [list variable $var [$v get]]
} else {
namespace eval ::${rootPath}::${handler} [list variable [set var $v]]
}
}
} elseif {[$mv type] eq "hPostConfig"} {
# Un script à évaluer après création
# Création de tout ou bien juste du handler ? A voir ...
set hPC [$mv get]
my lappendPostConfig $hPC
} else {
# "unknow type"
}
} else {
# "unknow type"
continue
}
}
namespace eval ::${rootPath}::$handler {namespace export *}
namespace eval ::${rootPath}::$handler {namespace ensemble create}
namespace eval ::${rootPath}::get::$path {namespace export *}
namespace eval ::${rootPath}::get::$path {namespace ensemble create}
} > - < - v - ^ - @ {
if {! $isWidgetCreated} {
# SubWidgets
# 1. créer la widget parent
if {[catch {set WidgetTree(peer,$path)} res]} {
if {$WidgetTree($path,wtype) eq "widget"} {
if {![winfo exist $path]} {
$wCommand $path {*}$wOptions
set isWidgetCreated 1
lappend ::${rootPath}::get::Widgets $path
} else {
if {[llength $wOptions] > 0} {
$path conf {*}$wOptions
}
}
} elseif {$WidgetTree($path,wtype) eq "mwidget"} {
if {![info exist ${path}]} {
lappend ::${rootPath}::get::MWidgets $path
$mwCommand $path {*}$wOptions
set isWidgetCreated 1
set path [$path rootpath]
} else {
# To do
}
}
} else {
if {![winfo exist $path]} {
$WidgetTree(peer,$res) peer create $path {*}$wOptions
} else {
# To do
}
}
# 2. geometry management
switch -- $WidgetTree($path,gm) {
Canvas {
[winfo parent $path] create window {*}$gmCanvas -window $path
}
Pack {
pack $path -expand 1 -fill both {*}[expr {($SIDE ne "") ? [list -side $SIDE] : ""}] {*}$gmPack
}
Grid {
# not realy done. To be seen
catch {grid $path {*}$gmGrid}
catch {grid ${path}_ {*}$gmGrid}
}
Notebook {
switch $SIDE {
"right" {
[winfo parent $path] insert 0 $path {*}$gmNotebook
}
"left" -
default {
[winfo parent $path] add $path {*}$gmNotebook
}
}
}
Panewindow {
switch $SIDE {
"right" - bottom {
[winfo parent $path] insert 0 $path {*}$gmPane
}
"left" - "top" - default {
[winfo parent $path] add $path {*}$gmPane
}
}
}
Table {
# not realy done. To be seen
[winfo parent $path] window configure {*}$gmTable -window $path
}
Text {
[winfo parent $path] window create end -window $path
}
default {}
}
# 3. gestion des évènements
foreach {bSeq bSc} $bScripts {
bind $path $bSeq $bSc
}
}
# continuation du processus
my make $o
}}
} else {
# On assume que ce sont des options
# tk_messageBox -message $o
lappend wOptions $o
}
}
} TkpItem {
$path create {*}[$e get]
continue
} spanTable {
$path span {*}[$e get]
continue
} scTable {
$path {*}[$e get]
continue
}}
if {! $isWidgetCreated} {
# SubWidgets
# 1. créer la widget parent
if {[catch {set WidgetTree(peer,$path)} res]} {
if {$WidgetTree($path,wtype) eq "widget"} {
if {![winfo exist $path]} {
$wCommand $path {*}$wOptions
set isWidgetCreated 1
lappend ::${rootPath}::get::Widgets $path
} else {
if {[llength $wOptions] > 0} {
$path conf {*}$wOptions
}
}
} elseif {$WidgetTree($path,wtype) eq "mwidget"} {
if {![info exist ${path}]} {
$mwCommand $path {*}$wOptions
set isWidgetCreated 1
lappend ::${rootPath}::get::MWidgets $path
set path [$path rootpath]
} else {
# To do
}
}
} else {
if {![winfo exist $path]} {
$WidgetTree(peer,$res) peer create $path {*}$wOptions
} else {
# To do
}
}
# 2. geometry management
switch -- $WidgetTree($path,gm) {
Canvas {
[winfo parent $path] create window {*}$gmCanvas -window $path
}
Grid {
# not realy done. To be seen
catch {grid $path {*}$gmGrid}
catch {grid ${path}_ {*}$gmGrid}
}
Notebook {
switch $SIDE {
"right" {
[winfo parent $path] insert 0 $path {*}$gmNotebook
}
"left" -
default {
[winfo parent $path] add $path {*}$gmNotebook
}
}
}
Pack {
pack $path -expand 1 -fill both {*}[expr {($SIDE ne "") ? [list -side $SIDE] : ""}] {*}$gmPack
}
Panewindow {
switch $SIDE {
"right" - bottom {
[winfo parent $path] insert 0 $path {*}$gmPane
}
"left" - "top" - default {
[winfo parent $path] add $path {*}$gmPane
}
}
}
Table {
# not realy done. To be seen
[winfo parent $path] window configure {*}$gmTable -window $path
}
Text {
[winfo parent $path] window create end -window $path
}
default {}
}
# 3. gestion des évènements
foreach {bSeq bSc} $bScripts {
bind $path $bSeq $bSc
}
}
}
# réinitilisation du chemin au chemin parent
set path $P
set isWidgetCreated 0
}; # fin foreach
}
}
}
package provide megawidget 0.3# Examples
# An editor
# A search box
# look of default style (when no options are set, default configuration)
megawidget create SearchBox {
top \
[title {*}[my getOptions [default -- Search] -title]]\
[attributes -toolwindow 1 -topmost 1]\
[v \
[widget ttk::frame [gmPack {*}[set Pad [list -padx 5 -pady 3]]]\
[> \
[widget ttk::label \
-text [my getOptions [default -- Find what] -findLabel]\
{*}[set labelWidth [list -width [my getOptions [default -- 10] -labelWidth]]]\
[set fillNone [gmPack -expand 0 -fill none {*}$Pad]]]\
[widget ttk::entry \
[set fillX [gmPack -expand 1 -fill x {*}$Pad]]\
[handler findEntry\
[hPostConfig {focus [%MW findEntry path]}]]]\
[widget ttk::button \
[wOptions \
-text [my getOptions [default -- find next] -findButtonLabel] \
-command [my getOptions [default -- {}] -findButtonCommand]\
-image [my getOptions [default -- [set ImgVide [image create photo -data {}]]] -findButtonImage] \
-compound [my getOptions [default -- text] -findButtonCompound]\
{*}[set buttonWidth [list -width [my getOptions [default -- 10] -buttonWidth]]]] \
[handler findButton]\
$fillNone]]]\
[widget ttk::frame [gmPack {*}$Pad]\
[> \
[widget ttk::label \
-text [my getOptions [default -- Replace with] -replaceLabel]\
{*}$labelWidth\
$fillNone]\
[widget ttk::entry \
$fillX\
[handler replaceEntry]
]\
[widget ttk::checkbutton \
[wOptions \
-text [my getOptions [default -- all] -replaceAllMatchLabel]\
-variable \
[my getOptions [default -- ::%MW::replaceAllMatchVariable] -replaceAllMatchVariable]]\
[gmPack -expand 0 -fill x -padx 3]\
[handler replaceAllMatch \
[hPostConfig {
set [%MW replaceAllMatch do cget -variable] 0
}]\
[hMethods 0 {} {
set [%MW replaceAllMatch do cget -variable] 0
} 1 {} {
set [%MW replaceAllMatch do cget -variable] 1
} swap {} {
if {[set [%MW replaceAllMatch do cget -variable]] eq [%MW replaceAllMatch do cget -onvalue]} {
set [%MW replaceAllMatch do cget -variable] [%MW replaceAllMatch do cget -offvalue]
} else {
set [%MW replaceAllMatch do cget -variable] [%MW replaceAllMatch do cget -onvalue]
}
} get {} {
return [set [%MW replaceAllMatch do cget -variable]]
} ask {} {
if {[set [%MW replaceAllMatch do cget -variable]]} {
return
} else {
return ""
}
}]]]\
[widget ttk::button \
[wOptions \
-text [my getOptions [default -- replace] -replaceButtonLabel] \
-command [my getOptions [default -- replace] -replaceCommand]\
-image [my getOptions [default -- $ImgVide] -replaceButtonImage] \
-compound [my getOptions [default -- text] -replaceButtonCompound]\
{*}$buttonWidth] \
[handler replaceButton]\
$fillNone]]]\
[widget ttk::frame [gmPack {*}$Pad]\
[> \
[widget ttk::frame $fillNone\
[v \
[widget ttk::checkbutton \
[wOptions \
-text [my getOptions [default -- Match whole word only] -wholeWordMatchLabel]\
-variable \
[my getOptions [default -- ::%MW::wholeWordMatchVariable] -wholeWordMatchVariable]]\
[handler matchWholeWord \
[hPostConfig {
set [%MW matchWholeWord do cget -variable] 0
}]\
[hMethods 0 {} {
set [%MW matchWholeWord do cget -variable] 0
} 1 {} {
set [%MW matchWholeWord do cget -variable] 1
} swap {} {
if {[set [%MW matchWholeWord do cget -variable]] eq [%MW matchWholeWord do cget -onvalue]} {
set [%MW matchWholeWord do cget -variable] [%MW matchWholeWord do cget -offvalue]
} else {
set [%MW matchWholeWord do cget -variable] [%MW matchWholeWord do cget -onvalue]
}
} get {} {
return [set [%MW matchWholeWord do cget -variable]]
}]]]\
[widget ttk::checkbutton \
[wOptions \
-text [my getOptions [default -- Match case] -matchCaseLabel]\
-variable [my getOptions [default -- ::%MW::matchCaseVariable] -matchCaseVariable]\
-onvalue [my getOptions [default -- 1] -matchCaseOnValue]\
-offvalue [my getOptions [default -- 0] -matchCaseOffValue]]\
[handler matchCase \
[hPostConfig {
set [%MW matchCase do cget -variable] 0
}]\
[hMethods 0 {} {
set [%MW matchCase do cget -variable] 0
} 1 {} {
set [%MW matchCase do cget -variable] 1
} swap {} {
if {[set [%MW matchCase do cget -variable]] eq [%MW matchCase do cget -onvalue]} {
set [%MW matchCase do cget -variable] [%MW matchCase do cget -offvalue]
} else {
set [%MW matchCase do cget -variable] [%MW matchCase do cget -onvalue]
}
} get {} {
return [set [%MW matchCase do cget -variable]]
} ask {} {
if {[set [%MW matchCase do cget -variable]] == [%MW matchCase do cget -offvalue]} {
return -nocase
} else {
return ""
}
}]]]]]\
[widget ttk::frame $fillNone\
[v \
[widget ttk::checkbutton \
[wOptions \
-text [my getOptions [default -- use regular expression] -useRegularExpressionLabel]\
-variable \
[my getOptions [default -- ::%MW::useRegularExpressionVariable] -useRegularExpressionVariable]]\
[handler useRegularExpression \
[hPostConfig {
set [%MW useRegularExpression do cget -variable] 0
}]\
[hMethods 0 {} {
set [%MW useRegularExpression do cget -variable] 0
} 1 {} {
set [%MW useRegularExpression do cget -variable] 1
} swap {} {
if {[set [%MW useRegularExpression do cget -variable]] eq [%MW useRegularExpression do cget -onvalue]} {
set [%MW useRegularExpression do cget -variable] [%MW useRegularExpression do cget -offvalue]
} else {
set [%MW useRegularExpression do cget -variable] [%MW useRegularExpression do cget -onvalue]
}
} get {} {
return [set [%MW useRegularExpression do cget -variable]]
} ask {} {
if {[set [%MW useRegularExpression do cget -variable]] == [%MW useLineAnchor do cget -onvalue]} {
return -regexp
} else {
return ""
}
}]]]\
[widget ttk::checkbutton \
[wOptions \
-text [my getOptions [default -- Use line anchor] -useLineAnchorLabel]\
-variable [my getOptions [default -- ::%MW::useLineAnchorVariable] -useLineAnchorVariable]\
-onvalue [my getOptions [default -- 1] -useLineAnchorOnValue]\
-offvalue [my getOptions [default -- 0] -useLineAnchorOffValue]]\
[handler useLineAnchor \
[hPostConfig {
set [%MW useLineAnchor do cget -variable] 0
}]\
[hMethods 0 {} {
set [%MW useLineAnchor do cget -variable] 0
} 1 {} {
set [%MW useLineAnchor do cget -variable] 1
} swap {} {
if {[set [%MW useLineAnchor do cget -variable]] eq [%MW useLineAnchor do cget -onvalue]} {
set [%MW useLineAnchor do cget -variable] [%MW useLineAnchor do cget -offvalue]
} else {
set [%MW useLineAnchor do cget -variable] [%MW useLineAnchor do cget -onvalue]
}
} get {} {
return [set [%MW useLineAnchor do cget -variable]]
} ask {} {
if {[set [%MW useLineAnchor do cget -variable]] == [%MW useLineAnchor do cget -onvalue]} {
return ""
} else {
return -nolinestop
}
}]]]]]\
[widget ttk::labelframe \
-text [my getOptions [default -- Direction] -directionLabel]\
$fillX \
[handler direction \
[hMethods up {} {
set [%MW up do cget -variable] [%MW up do cget -value]
} down {} {
set [%MW down do cget -variable] [%MW down do cget -value]
} swap {} {
if {[set [%MW down do cget -variable]] eq [%MW up do cget -value]} {
set [%MW down do cget -variable] [%MW down do cget -value]
} else {
set [%MW down do cget -variable] [%MW up do cget -value]
}
} get {} {
return [set [%MW down do cget -variable]]
} ask {} {
if {[set [%MW down do cget -variable]] eq [%MW down do cget -value]} {
return "-forwards"
} else {
return "-backwards"
}
}]]\
[> \
[widget ttk::radiobutton \
[wOptions \
-text [my getOptions [default -- Backward] -upLabel] \
-value [my getOptions [default -- -1] -upValue]\
-variable \
[my getOptions [default -- ::%MW::directionVariable] -directionVariable]]\
$fillX\
[handler up\
[hPostConfig {set ::%MW::directionVariable 1}]]]\
[widget ttk::radiobutton \
[wOptions \
-text [my getOptions [default -- Forward] -downLabel]\
-value [my getOptions [default -- 1] -downValue]\
-variable \
[my getOptions [default -- ::%MW::directionVariable] -directionVariable]]\
$fillX\
[handler down]]]]\
[widget ttk::button \
[wOptions \
-text [my getOptions [default -- Cancel] -cancelButtonLabel]\
-command [my getOptions \
[default -- eval {wm withdraw [list [%MW rootpath]]}] -cancelButtonCommand]\
-image [my getOptions [default -- $ImgVide] -cancelButtonImage] \
-compound [my getOptions [default -- text] -cancelButtonCompound]\
{*}$buttonWidth] \
[handler cancelButton]\
[gmPack -expand 0 -fill y {*}$Pad]]]]]}
#SearchBox .sb; # no need to pack since the 'top' typedlist creates a toplevel window# a scrollable text widget (with the search box in it)
megawidget create scrollText {
{*}[package require stext; list] \
> \
[widget frame \
[@ \
[widget scrollbar \
[wOptions -orient v -command {%MW text do yview}]\
[gmPack -expand 0 -fill y -padx 0 -pady 0 -side right]\
[handler sy]\
]\
[widget scrollbar \
[handler sx]\
[wOptions -orient h -command {%MW text do xview}]\
[gmPack -expand 0 -fill x -side bottom]\
]\
[widget [my getOptions [default text] -type]\
[wOptions -yscrollcommand {%MW sy do set} \
-xscrollcommand {%MW sx do set} \
-font {Times 12} -padx 4 -undo yes ]\
[handler text\
[hPostConfig [list eval set ::%MW::mwHasFocus %MW]]]\
[gmPack -expand 1 -fill both]\
[bScripts \
<Control-KeyPress-f> {
if {![catch {.sb0 rootpath} path]} {
if {[winfo exist $path]} {
wm deiconify $path
}
} else {
if {![info exist SearchBox]} {
if {![catch {source SearchBox.tcl.oo}]} {
break
}
}
SearchBox .sb0 \
-title "Rechercher / remplacer " \
-labelWidth 15\
-findLabel [list Rechercher : ]\
-findButtonLabel " Suivant"\
-findButtonImage [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsSAAALEgHS3X78AAAAB3RJTUUH1gQFEiQGzcQw7QAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABuElEQVQ4y5WQT2sTQRxAn+LJiMRK4oRAJH4AQ4QQpBcFLRIR
W0IVrGHTgyyBgBShCJ6DYRGkRO1FGwnopabJpSDWQw9ewnrJZ9hLsmQ3uWQJLNnxVC3d/LEP5jL8
fo95c4Z/LJa10i/mc/fl5qufvtuyVpKe5/mO67rSdV3pOI50XVeWtZIsa6U7R3tnT4ps28ayLKye
Ra/Xw+7b/NZ1vv/Yp2t2ebGxCXBwJPEJpJRIKfGQeFIiPUn8Wpx+v0/gfICu2eXpmgJwAHDOJ/Ak
1c9VvuzWAVhbzZLL5bgQuMhecxfHcRgOh0xN2KnuYBgGbb1FW29hGAa1Wo1k8gZXY3ES15PcW7r/
d973gq/f9mjrLTqdDgCVSoVEKk0mkyEUCjEajQgGg9MFs1i4dBmAaDQ6PWH14QNUVUUIgRCCYrHI
7cWbjMfjiVKfIJ/PE4vFSKTSJFJpBoMBC+ErKM9UTNP0CSYmKIqCoigAmKbJulogu7LMulpge+vt
7ISThMNhPm2/p95okl1ZpvB8Y3bCJIQQfPzwjnqjyZPHj+YnTCISibDfqM//g+N9/8NxwaH25vWt
U+weAvwBJMy7D74rFGYAAAAASUVORK5CYII=}]\
-findButtonCompound left \
-replaceLabel "Remplacer par :"\
-replaceButtonLabel "Remplacer"\
-replaceButtonImage [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsSAAALEgHS3X78AAAAB3RJTUUH1gQFEiUq5gdtTwAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAACIklEQVQ4y42SX0hTURzHP7uZQZMQH+ZgOrCX3jTmVGJgRfUY
FeKTd2kPMYSJSCCKUEmMxujNSoRaEAaBmHsRwlVIJIH/qNFL1EvewZjujy+7FLfdXw+y2+aM/MLh
XM45nw+Xc742/sYXjoQ+8P9cGhudeFO1Go6ExDTNqmEYhhiGIbqui2EYEo6EJBwJXSxxyn5RLpcj
m82SzWTJZDLk8jnW19Z4vbRIejvNrZFRgHhJUiUQEUQEE8EUQUyh5WQL+Xwe+3E76e00al8/QByg
Zr8gGo3yYm4egL7eHq77/QhQZz/Bq9gcuq5TKBSs87byO8A8QjKZZGpqCoChoSGamppQ/Sq6rrO1
9YPa2lrqZs6WML9lSiQS0urtFBGRVColqVRKRERavZ2iJTXRNE0+Jz7JpooUviC/F7plU0UUDhPZ
m4qR05wag2Pfuvm1+r7yFYrFIud9ZwgGgzidTpxOJ4FAgN4rlwHYGW+ugL9qANxWADY2NqT/ZoAG
RyO7u7u0dXTR1tGF2+1mYGDgQPh74wU8s9yrWVlZkRuBQXquXWV+IcazmWkcDof19wfB7sBzlj5q
wFubMjg8YsFPpx9VwKWUw/XBRRp8KuVNvDu/EOPJ44e0t7dXgDvjzXhmYfjlTws+6mq1CgdITWJ9
dRKYfLccF6/XWyHwzMKmCvXBOxZoFci2V6GqJrpcLuvbNM1/vmxpr1ywHHlw/xyHjKIoywB/AHbf
HIE0q/ujAAAAAElFTkSuQmCC}]\
-replaceButtonCompound left \
-replaceAllMatchLabel "Tout"\
-replaceAllMatchVariable [set ::replaceAllMatchVariable 0;list ::replaceAllMatchVariable]\
-wholeWordMatchLabel "Ne rechercher que
les mots entiers"\
-wholeWordMatchVariable [set ::wholeWordMatchVariable 1; list ::wholeWordMatchVariable]\
-matchCaseLabel "Respecter
la casse"\
-matchCaseVariable [set ::matchCaseVariable 0; list ::matchCaseVariable] \
-useLineAnchorLabel "Utiliser les ancres
de ligne"\
-useRegularExpressionLabel "Utiliser les expressions
régulières"\
-directionLabel "Sens : "\
-upLabel " En
arrière"\
-upvalue -1\
-downLabel " En
avant"\
-downValue 1\
-directionVariable [set ::directionVariable 1; list ::directionVariable] \
-cancelButtonLabel Annuler\
-cancelButtonImage [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAAAmJLR0QAAKqNIzIAAAAJcEhZcwAA
CxEAAAsRAX9kX5EAAAAHdElNRQfWBAUULRDsX0JHAAAA7ElEQVQoz72QMUvDUBSFv5qCg6PgLLhU
MlToLDg4pdTxDM7S/APHtH8j/0DeKPqydPEHZHx0kKCQITo4SdWlPIeXlOoqeJbL5Tvcc7jwV0Vh
KIvzeN89tNvspDiOug2A69c7L69ZwPK3Xk+B7ITxfPCFYA7A/IoXOAyk355ITX7GBazgkpoFpAH0
uhAl3J+zB6xYwNjYHxFgbGRr+uxSE9kObxk0WCdDPvy7H7JONPhl0JSlqCg+i7cKwVLTLYMyclFR
wojTkgpBrmxTUr7FY2ND3RFHGEyv/WTcuEkDqbkBcI9x00wcpK7kP/QN44JSLNJT/ssAAAAASUVO
RK5CYII=}]\
-cancelButtonCompound top
.sb0 findButton configure -command ::%MW::searchrep'next
.sb0 replaceButton configure -command ::%MW::searchrep'rep
.sb0 cancelButton configure -command [subst -noc {
event generate [[set ::%MW::mwHasFocus] text path] <<HiliteRemove>>
wm withdraw .sb0_
}]
wm protocol .sb0_ WM_DELETE_WINDOW [subst -noc {
event generate [[set ::%MW::mwHasFocus] text path] <<HiliteRemove>>
namespace delete .sb0
destroy .sb0_
}]
%W tag config hilite -background yellow
proc ::%MW::searchrep'next {} {
set mw [set ::%MW::mwHasFocus]
# set mw [string range [[winfo parent [%MW rootpath]] select] 0 end-1]
$mw text do tag config hilite -background yellow
foreach {from to} [$mw text do tag ranges hilite] {
$mw text do tag remove hilite $from $to
}
expr {[.sb0 matchWholeWord get] ? [list [.sb0 matchWholeWord ask]] : ""}
set cmd [list $mw text do search -count ::%MW::n \
{*}[expr {[.sb0 useRegularExpression get] ? \
[list [.sb0 useRegularExpression ask] {*}[.sb0 useLineAnchor ask]] : ""}]\
{*}[.sb0 matchCase ask]\
{*}[.sb0 direction ask]\
-- [.sb0 findEntry do get] insert[expr {[.sb0 direction get] < 0 ? "-" : "+"}]2c]
set pos [eval $cmd]
if {$pos ne ""} {
$mw text do mark set insert $pos
$mw text do see insert
$mw text do tag add hilite $pos $pos+${::%MW::n}c
}
set pos
}
#-- Replace the current instance, and find the next
proc ::%MW::searchrep'rep {} {
if {[.sb0 replaceAllMatch get]} {
::%MW::searchrep'all
return
}
set mw [set ::%MW::mwHasFocus]
#set mw [string range [[winfo parent [%MW rootpath]] select] 0 end-1]
$mw text do tag config hilite -background yellow
set pos 0
if {[$mw text do tag ranges hilite] ne ""} {
$mw text do delete {*}[$mw text do tag ranges hilite]
$mw text do insert insert [.sb0 replaceEntry do get]
set pos [searchrep'next]
}
}
proc ::%MW::searchrep'all {} {
set mw [set ::%MW::mwHasFocus]
#set mw [string range [[winfo parent [%MW rootpath]] select] 0 end-1]
$mw text do tag config hilite -background yellow
set pos 0
while {[$mw text do tag ranges hilite] ne ""} {
$mw text do delete {*}[$mw text do tag ranges hilite]
$mw text do insert insert [.sb0 replaceEntry do get]
set pos [searchrep'next]
}
}
}
} <<HiliteRemove>> {
%W tag remove hilite 0.0 end
}]]]]}
# a toolbar megawidget - to be fill with a typedlist
# The toolbar definition, a big typedlist whose :
# first type is toolbar,
# second type is barre
# third is groupe
# forth is element (the second member of it is a wegawidget to be evaluated)
set toolbar {
toolbar \
[barre "fichier-impression-édition" \
[groupe fichier \
[element "Créer un nouveau fichier" {
[widget ttk::button \
[handler nouveau]\
[wOptions \
-text "Nouveau" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsSAAALEgHS3X78AAAAB3RJTUUH1gcYDTY4hvhMSgAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABz0lEQVQ4y6WRTWsTURiFn/femQlpzRdtDDJprJsKdicFF10o
uOpPUPBfiODCZbEEwf+gG11WN7qrmI0FcSGiTelCqR8EnWYQkjTJ3NfFtLRji58HLtzNee655wip
Fleayy0yckzmBpyciqhXtylORFQrnZeTeffa2hNPrV9pWa/0WQBWmst64/rNrH0cMe4/J/n+gFHv
BcnwPQBiy7t+UNnygtpD6xXve4dNURShqpAMMboB0VXQXcBRPvsNgO7GVG7Y754bDj7cKlQudzIA
VUWdA/qIbqE6pjT3EUH3QFCe+4QC8WbDgl40GYBTFAc6wLgdQPfOsRJEzmQATh3OgapBxSdXWCRu
10HkUEqI2yEThfMjES9njnxBFed8EmbA1AGD2OpBFhEQi/VKPTBfjwUkEjByMwzNAohFk4i43SBu
NxDxAIuY3BsR08qW6Fz6khrGVBG3QFC6S7c9S75yDVDizdNsd68wP71zD1j/qYM0QSqfESEDd4Fx
8RE9XaKnS5Rmn/Dq3SmAx8Bbj1/KJ5FpEsqINtIWgpBO9Azgi1dbdb8BABggQPfnlDxODV5t1QH8
AeBg9nQEOYL/L2UShGH4z4C15p3bl/7Ct7Z/+QEaBsWReLF9uwAAAABJRU5ErkJggg==
}] \
-compound top \
-style Toolbutton]]
}]\
[element "Ouvrir un fichier" {
[widget ttk::button \
[handler ouvrir]\
[wOptions \
-text "Ouvrir"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gkWFgcEIFayvAAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABsElEQVQ4y6WSS2sTURzFf3c6giWktRql7roLqIv5CA1FtBtd
pC+6cVGQItFvIz6w0l1F+gG6qa0WxFUIgQhu0hJd9arptJ1mHr33uhgbcjsJFjybC//nOf97xJPK
8q6UcoJzKBQKX188f3Wbf8CVUk5UKo9wnKFu8CTo8GZl7RYXgAsQxyG7e00wBmMMN67fBGB2vmwG
NY6NXdl+/XKl5AKEYUQQnKQZA99/tJgp3yOKIwQOCGE1x3HCxsanyS6DXjQae/h+ANT7bh4fv4rn
3bEl9ML3A96/Wx+oeW5hJnsDpRRJEluHbLd/9dF9DYAkSewBWmvSV3UTtVotM6BUmiK9WcceEEUh
nU5oFXuex4W/ceiSSxwlVmJn5yNvV1dRSmWaNje/kMvlWFicWxOz82WTz+eRUlpFDx/cpVgsMjKS
50zmqTrFGDBa8WHrM9VqPWXw7OkSxmQ9c3zs02w2EOd8ADB9f4pqtS7d1DuGVutbX42O42RiWmsO
DnyAIxeg/fsno6MFi8XZVpuY+RsTHB76AL54vLy0tb8vJ9PJA62P44geBobh4ctHWutF/hd/AExB
ukCW3MYjAAAAAElFTkSuQmCC
}] \
-compound top \
-style Toolbutton]]
}]\
[element "Sauver le fichier en cours" {
[widget ttk::button \
[handler sauver]\
[wOptions \
-text "Sauver" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gkMFDIjG02m9AAAAWJJREFUOMud0T1LQmEUwPH/vdwX
UIS4i0XXEAqHhCCqtQ8gTU3imIhfoKGWIBeD6AX3hCAqGpqCBqeWlhpqsSUKvQ0JJbdueikTW9K6
vteZnuc55/x4Dkfwh5IHQBjgWFumn5gvJuvHQwkIp9eiuFSJiexpX0B6NArAwtJOWKo/Hp3nmIxk
+gJO9rPMTQ0DIDUnC4VC12av1+u4OwBZltE0rStQqVQ6AwCGYXQFfD5fd6C5oFe0AC6X6//A4u41
fw0HYD/neDcfOharAzrB8SB3hbcOwOsTkdkAbrcbAF3XURQF0zTJGwZ7Z/fcPo4wNuhpDwif5Ubz
dmoTgI31LYrFItRqSLUPhKZfiQ7gO6vrestaFUVpO5YIcHWTJzDkaTTLsuwoqlarWJbVEUikdjOU
X0wEQBRFTNMkFo0Ti8YplUrYto2qqoiigCCAJP4MIgD4Q8lVYGXGc9lzbRfW9O9r4gssDGODbsmD
UwAAAABJRU5ErkJggg==
}] \
-compound top \
-style Toolbutton]]
}]\
[element "Sauver le fichier en cours sous un autre nom" {
[widget ttk::button \
[handler sauverSous]\
[wOptions \
-text "Sauver Sous" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gkMFDMPMI77VgAAAepJREFUOMuVkT9oE3EUxz+/H3cX
TIhI8C9eNKAUaUGoWkQQN5fiIDoYu1iMobPgoCCCXaKIxkZwEQtFoRoTJ8GhS0NrFx2slhY0KNdT
6tEknsY0akzOKbGXP4pve7zv5/ve4ytC/bFxIAzwOHCBdpWpSgB2iRqbJBwrxOqjBwoQHr0SwetR
2D3/tAW+lZzm1Mg0xtQjJlMjHD5+kNEdEQBOn78bVurC5IxB78CEC749uIbBxDPMzD1mF5YBWOq+
ypOZjxzZuxUA2bzRsiwsy3LBr97m+Tyfpu9EnI2hPTiO09Arq2FVVQkEAgAYcj+vJ6cw3iyTm0tz
9GKGDdt7qVQqroUtF5imyZ3oWrJLeR6mUuTm0hw4k+S7XI9pmjiOgxCi/QUAwWCQs+M14iezja1/
qxYDr9dLrVbrCDTPXAbnxmb533IZlPMGP+wPHcWedTo93T28s751MPiaY+BQFz6fDwBd19E0Ddu2
WTRN7mfek/20jZ2b/e0NxK+VBnwzcQOA69fiFAoFcBwU5yei6SpXjPV0dF13xQqgaVrbtyTAy4VF
urb4G7Cqqi5RtVqlWCx2NBhOjE2w8sVGAFJKbNsmGhkiGhmiVCpRLpfxeDxIKRACFPnnEQEQ6o9d
Bi71+V/8M7bnxX2r2+HfvP+vtN9RGaQAAAAASUVORK5CYII=
}] \
-compound top \
-style Toolbutton]]
}]]\
[groupe impression \
[element "Imprimer" {
[widget ttk::button \
[handler imprimer]\
[wOptions \
-text "Imprimer" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gESDwQidZMg6wAAADV0RVh0Q29tbWVudAAoYykgMjAw
NCBKYWt1YiBTdGVpbmVyCgpDcmVhdGVkIHdpdGggVGhlIEdJTVCQ2YtvAAABcUlEQVQ4y8WSvy9D
URTHP7feky4o/0AxsWHBLFEkFokI6dqkERIWEbsEC4nJJhGrsUOlxIQQHZmkGFvt6/B+0OcdQ5VX
T5AYfJM73HPP93u+95sDf4TyX9KZ1Dqw9ANnZ3hoLPnlSzqTEsex5TukMynxc7TPIka5TKl0Szgc
DgxoaW4N1EJ/zSDgwLItTMukUqkEm7XGYG1tY7UN6DOM8qFC4TgOruvivXj1VhtC2LYNwPLKkkQi
LRPASQiYy+XuDuMzcUzLpJDPUywWKTwW6o5RMrBMC4D4TJxc7u4AmFPJ2YRsbW6jlGJvf9cRTxp0
XUdv1HVN8/1Q4Pn5iabmJkZj44gIC4vz1Qw0TePy8oKpyenwWy+Ih0iNKyAKlAcC2ewVPT29HyG6
boWOznYs2/xV8h2d7bUxVYH7+wfOzk/r7AbhKyrFQP/gh8BV9gJE6Oru/k7hHTfXN1WOfw9iI7Ff
L080GuX4+KhqJjmbEP4Tr7/OtONaCDS8AAAAAElFTkSuQmCC
}] \
-compound top \
-style Toolbutton]]
}]]\
[groupe edition \
[element "couper" {
[widget ttk::button \
[handler couper]\
[wOptions \
-text "couper"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAKABpAOmWInXJAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gcRDwEkfHIr1QAAAWFJREFUOMutk79LAnEYh59CbBF0
KMqQqCESkrgM1Dl3oc7zCnIKrKSlpTEIK/8Bs4ZaqiG5HByi/gQVySVoadDS1KOtmq/lDDs8Hepd
vu/7ft73+f6G/zRJFp2SLGommibJomDMDxridb1YMDS349V+gETyIAFQNuTLycQewG4/AENWK8HF
4M+skiwKnlkPX58fXbdtBNy3WirCnAeHw9FeRTm+EaNSeQXI9QOkr5UbHHY77hk3kiwKAX8AVa3z
XKkBnPcDlKovVWw2G1MTLoByJLyE2myQL+QBSj0BSibbAMb3D49wjg0D8N6skz67eAPmdf2XDZjc
+RqwA3iBGpBUMtl0t1qLoelSDx+Ax63N+NPJaVoVl8Mx4FjXokome9X1pS0seEOapvklWdSKxUIK
oFgspIya6Rnc3eYKwDSAz+ff7hw7NVPAyKhr0uyfmGmWDj8aWQnndT9kqOul/c2+AYM5e2TGPMA+
AAAAAElFTkSuQmCC
}] \
-compound top \
-style Toolbutton]]
}]\
[element "copier" {
[widget ttk::button \
[handler copier]\
[wOptions \
-text "copier"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gETCToqhryocwAAAK1JREFUOMutkk0KwjAQhZ+QCxXE
AwgueiB/0IXJIhLjgVwIHkCayZHqpglSJtO0+FaBDC9fPmblvL0C0JCjT4eLYW+ct/1UnLd9qVml
w+v9ZAd221ZEywXrZoMlyQVd/PyPIFCHQAEAQCFmV5xYloAo4rg/iy/fHzcNwLAE6dUasaKDGrGK
a00ENWIVAD38ZxnBsKJmvJ1zCIqZ5YDLmIArFAumtlAqKIr9nQGAL0ezaR+0HlviAAAAAElFTkSu
QmCC
}]\
-compound top \
-style Toolbutton]]
}]\
[element "coller" {
[widget ttk::button \
[handler coller]\
[wOptions \
-text "coller"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsRAAALEQF/ZF+RAAAAB3RJTUUH1gQFEjM27p6E1wAAAYtJREFUOMuNk79r02EQxj/33Gua
SWqlILaCiCiIOImhsV+UdHVUtEIhIOgmdBChf4BBKnSug2vaRZTiFGjtkEJjJNEt4j9QzBIwFKv9
MaRfTZvYfp/p7rh77u557zUO4dr1G4+B+a7Qk6/Vymv+A5ub1H1gIQ68+XyGtx9WSafTtNttHt27
xd2rP7prHkwXdxZjR8BCvlAmXyjTPP+U3YEhdrb/8L1RR4IWw5zOzRLndDeLCQDYahRZKq2xUnrH
9u8Wg4Mn+dnaYKX0nlfzi2w1in1XCN3OVG6UiTsPe5KmcqMcpcFuvlA+0GHp2ymamykS4GPoF21u
pnj+bObY6pezL26HoxJq9U+YHHchOe6OTMjFxQuXejU4DA+BWq2OScgMmTAZY2PZ/iL2KBwCmUwG
lyMXMnWmkCck8BNUq1UkYWaYOlOMj0fJJ8jezOLqaCD5vq1kBB6cynoFMyEZURT9JUm4QiCKos5L
KN5f/QlSlyf/VX5ZBmDk7Lljb6HnNwL8ujINA0NJLnFjDzcHYFcB8qBPAAAAAElFTkSuQmCC
}] \
-compound top \
-style Toolbutton]]
}]]\
[groupe undo-redo \
[element "défaire" {
[widget ttk::button \
[handler undo]\
[wOptions \
-text "undo"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAuHAAALhwGTQIdTAAAAB3RJTUUH1gQFExU5vD1wVQAAAcBJREFUOMulk81LVFEYxn/33DvR
KERWgrSRkDYG0ipo0R+Q4SJcKIncgTDJHGJWLachaHuJIXAcwnu1iDYKiS0icSEELYwIMkYRmhAE
myimr4tzPa+Laa4z6shE7+58PL/3fTjPgTrlOggNlPof8YEA10HskTeN6rH2iW/OA8G+SVYi6tz9
Ub3MYZ7FXxAppkR+PxMpfRDZWhIpfRQpXBbXQVJpdWuvzqjp7D+vMtcG5unyNJELECzjZfrIW2o0
GdcPK9dM10HsoSxsLdai5SfID1AnQRfgSBfnO0t8ervU3dmjni6+kK8AVt5Sw152KGMP9rCWmz3Q
XseZFmh5DNFrBEGWJlMGgGRoIZVWN9oDnbEHr7CWm6Pj7CU42vvXygkwmtEolHkc/Gm8iTSxRFlr
VLpUQ9BFvCe7lrSGfvsR0egxUBbe2NUQEOYgGdfjeUsNe1NzYJ4CIJbAiCUwfpm8e/3qOsgfEL9+
kELI5EzNpU1T3VnfAIxm2F4/PIkVSPXevbh+WX6ZIoUv3+onsRoCjIfrtOoj0LD9mdXV9/hwl38p
10Hke0Jk86Ls/WhWI4AN03jgTTi3AXIR1Qo6PNsBOQfAIQY63fcAAAAASUVORK5CYII=
}] \
-compound top \
-style Toolbutton]]
}]\
[element "refaire" {
[widget ttk::button \
[handler redo]\
[wOptions \
-text "redo"\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAuHAAALhwGTQIdTAAAAB3RJTUUH1gQFExQJg/9xuAAAAahJREFUOMuNkz9oE1Ecxz8XQ9Rk
k1zcFUJpoY5BcFFB6NKCS+CCdmi5WLTg5h9QcHErKEQsASkoqCgiOdNFJKWC0KHQILHQhraoJEaj
IeaKFy65PgebeMkl4d74vu/zfb+/4OKMJ32in+bB5eln4trgweRKTxNvn9+GgU/2OyE1uXcxA5wR
mmpKg0K9PJ70iScVRZQbeVE0P4ofjQ2RM1JiSZ8TO/UPwh6J1A0DibsXXiJ7wxQaa3jwUtsrsWuV
2++GDp7j6uOzaKopSTY4DGxMRWc56VcpNXNYosEvawdz748j0qPNE9x5pXTUICb0w4weOk/V+spi
7SbF7UrPNCOywnxGAYjbDW5fmr4CwKPPMcKeMULBTjD7c5FIUOFF5iFAXFPNZEcXjvlOka5dJ+wZ
I5V+DQGjrU2cVv7BS/9hxxw0qeOvHie/tQkBI6upptRqmf/AEQfsMPhtfQNg/csqwDW79uxdwgE7
DBaWbxGSQwBoqvm2q3YOuNtgpFzQqQu91dZoS9hPJTlwFzTVXAeofjeYid4AeO5mR7p3QX7z/mlr
5O67MfgLr36xHQjcVi8AAAAASUVORK5CYII=
}] \
-compound top \
-style Toolbutton]]
}]]]\
[barre "style" \
[groupe police\
[element "Selecteur de police" {
[widget ttk::combobox \
[handler policeName]\
[wOptions \
-width 30 \
-values [font families]]\
]
}]\
[element "Sélecteur de taille de caractère" {
[widget ttk::combobox \
[handler policeSize]\
[wOptions \
-width 3 \
-values [list 6 7 8 9 10 11 12 13 14 15 16 18 20 22 24 26 28 32 36 40 44 48 54 60 66 72 80 88 96]]\
]
}]]\
[groupe justifier\
[element "centrer" {
[widget ttk::button \
[handler centrer]\
[wOptions \
-text "centrer" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEjYX34BgzAAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABLklEQVQ4y6WTv04CQRDGf99wlj7JhRdRSPTwT+SuwlBIY2JB
SIiVISEklmKhvWBj8JTnMMFLfByLPQ7UlYBOstmd3Z3vm292RwD9Qe8aaALbrG/NTrt7H/QHvVZl
p3oRhmU2sSyb3QFbAXAThmXeP968F2VCMgSYSkggGWFY5mWaDoPvAa/pdCVz7SBCssL/AVCp7oIJ
wxw7QhJmbkb6HcDMAJFOUi/74fERAj+AmTkmGfvRHpLyYcXaTAjnewEmT89rvUCcJD6AElEtwgrm
pQxy/ZanLvNKcOnNAcbjxy+sSZIguXO8EmSwpPekXkdy+676hmlRaK8ESYweRiv1NxqnyAcw1xjH
MTJDyKVrjlnY4n8s4gmAqyybXf6hFwDOlXfjGTBkM2t12t1b/mufptE0XTWKobMAAAAASUVORK5C
YII=
}] \
-style Toolbutton]]
}]\
[element "aligner à gauche" {
[widget ttk::button \
[handler aligner_A_gauche]\
[wOptions \
-text "à gauche" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEjcdJk64kwAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABKklEQVQ4y6WTwUqCQRSFv3O0ZU/y44tYmhhpaGAbF7kJWogg
rUIQoWW2qAdIoqIsnyMwocdpMaZmU2gdGIZh7nz3nssdAXR7nXOgDmyyuuqtZvs63e11GtvZ3EmS
ZFhHk8n4CthIAxdJkuHt/TUaKAvJCLBSSCCZJMnwPBr204vBL8PRN8BOIT97hIQVgJ/6AtjKZREC
C+OQHSEJO+z8BohVsKxSuRQH2CZfyGEZSQtrfraFCOco4PHhKZq1vF8OEIwdbEQAKYq7xWmTliqY
+ve0dDlqQdzd3q80A7XaYQQgs1cuLVRgJGY9QcYKVuEHC4ObweyielCdeV5upmIASVQqlRBgI8LQ
4JBZeD4f8/ekgbPJZHz6h78AcKzpbzwC+qynRqvZvuS/+gD+wTRHRQnRRwAAAABJRU5ErkJggg==
}] \
-style Toolbutton]]
}]\
[element "aligner à droite" {
[widget ttk::button \
[handler aligner_A_droite]\
[wOptions \
-text "à droite" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEjctAJeIPwAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABL0lEQVQ4y6WTz0oCURjFf+c4LXuSwReJIgP/QYKluchN0EIE
aRWCCC2zRW1cm0EoPUdgQo/T4k5j5AhaBwbunTvf73xn7r0CGAz7d0AL2Gd7tbqd3lM0GPbbhwdH
13GcZxctl4tHYC8C7uM4z8fne+aHspCMACuHBJKJ4zzzt9ko2uQgCSFmr/O1tWKpmI7XAEJgYYws
CicFJGELBXskZwNsZzr+VqVaXQfYRhKFk+PQfvo4HdtChPkGQFi0BDLTyXNmB6e1WhYghwjF346V
SjlAk/xOssvOAojp5GWrM1Cvn2UAZEqV8o8OjBTeK4lkhaigDRGSbXJSLJxu33g8TouajYt1gNJC
ITv9Hzg4N86bq/OxaoAIuF0uFzd/uAsAV0pu4yUwYje1u53eA//VF0RwNHxq/wS4AAAAAElFTkSu
QmCC
}] \
-style Toolbutton]]
}]]\
[groupe indenter \
[element "indenter moins" {
[widget ttk::button \
[handler indenter_moins]\
[wOptions \
-text "moins" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEisIreQBJQAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABXklEQVQ4y6WTu0oDYRCFvzOupb0JVoJRWBZ8BsFC0UbFQCR2
FqYRBDXGC5J4iRFLtdAHULygKD6HEFds0kl8DYvdrAlZxeBp9sI/35wz/COAcmXvGFgAevi7FvKr
GxdOubKXmxifXHZdj07k+9VzoNsBTlzX4/X9pe3QZ/2TZF8SyRBg6kICyXBdj6fnx1On+XCc6h/1
2P8D/UMARIBEMgGAEJgwDJkQQhJmwRMJySKQ00w1M3a2ixRLO8jE/d3DjzNYWym0AhrFjXdJTM9M
BfnV5ILgu81Bo7gBQMbt9c3fHezul9gsbAWAsGs6PRs4CPNbmF0WMwMzcVDeZz1fiBxcXV62dM1m
57FwkO0ABUWVo8Mws5GZy0RukGEK4xEDqNVqHd3E0ZGxVkAqNRh1kxlC+G9VPG8YEwj7vh/fBnCA
ku9Xt+J2Idnb99suACwp3MZF4JTOlMuvbpzxX30Be85KsJbNCAcAAAAASUVORK5CYII=
}] \
-style Toolbutton]]
}]\
[element "indenter d'avantage" {
[widget ttk::button \
[handler indenter_plus]\
[wOptions \
-text "plus" \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEisjAVj4ZQAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABYklEQVQ4y6WTTStEYRiGr/txLO2ZZqV81OmU36AsiA2iiJ0F
G6UwGR9jmHFMWWLBDyAfEfkdahzZzE7jb1icM2dmmkMm9+bt/eh67vvpfQTglwonwBLQxd+1lNnI
Xjp+qbAyPjax5roe7SgIyhdApwOcuq7H28dry6Ov6hepdArJEGDqQALJcF2P55enM6fxcZKqn9XE
877eQQBiQE+qBwAhMGEYMiGEJMzCFQnJYpDTSM3nDsnl9zAJmXi4f/yxB5vrW80As5Ca293nsJBH
ElPTk2F+Nbgg3Lc4qAEAtrO7FP0idze37TjoiC99v4gkZmdnQgdRfouyyyzJQWjr+PgoapZxfXXV
VHVhYRGLGtkKkOGX/DivZMzNz2FRD5BhqkVNAFQqlbZ+4sjwaDOgv38griYzhAjey3jeECYQVv8f
dQM4wEEQlHeSZiHVnf5tFgBWFU3jMnBGe1rJbGTP+a++ATGdSuStbu4kAAAAAElFTkSuQmCC
}] \
-style Toolbutton]]
}]]\
[groupe formater \
[element "gras" {
[widget ttk::button \
[handler formater_gras]\
[wOptions \
-text gras \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEjkA28v5xAAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABl0lEQVQ4y6WTv06TYRTGf8/z1qWJSa+BFpYvvYf+czE6Sq+A
QRYSMYSEOBkSQuIoDnoBOCuMaEKnDv3LB94AMFCCDmrJ18GhpWL4SESf8eSc3znnfZ8jgI3N9VfA
AnCfv9fC6srau8zG5vrio4ePn0VRkbsojvtvgXsZ4HUUFTn40klNlIVkBFgBCSQTRUU+7n7YytzW
QRJCWJ4WIWGNgVe6ARACi/3P++ztfQKg9qBGpVJCY9IfAF8vto1sfn7/Qa/Xm8a7nQ7D4SVywDJO
A9hGEsHm9OSUweCcXC5HNpvl7GzA8fEJwSI4EHwLwA7IptvrA5Av5JnJzwDQbrW4HCbTKVMA4/G+
XXzl6PAIgNlCgbnZOQD6/QNGoxGSsFMe0RbCxPEhSZIAsL39fpqYJAndbpdyqQRSCkAGmVa7DUC5
XKZaqxAc2NnZpdFo0Gw2qVYrQBrAAUksP1/+/fcYW8zPP6Fer4+9MfHHDYB0ZRohe2IigY0nMCyM
r29ABngZx/0X/3ALAEuaXONTYIu7aXF1Ze0N/6tf6mBso7lqg2QAAAAASUVORK5CYII=
}] \
-style Toolbutton]]
}]\
[element "italique" {
[widget ttk::button \
[handler formater_italique]\
[wOptions \
-text italique \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEjoBh+GakQAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABpklEQVQ4y6WTsWqTYRiFn3O+SJuCS2hChZhewE/WrAbsJHoZ
HYxixKEUipMUSopjk0HvQhHsUA2CBeMgxICQO0gTaaM0SVOoQ2Kq+BesPvN7nu/l47wC2KpsPgVW
gav8PavraxvPE1uVzdLtW3ceRVGey9BqNZ8BVxLAThTl+fzlU+ygLCQjwApIIJkoyvPy1Ytq4qIX
JCGE5VkICWsi/MkfAiGwMEYWtZ0aZ2fwoHwfTUy/Cfxr2DayCTIOovGhwXwyyeHRIcPhEDlgGccJ
bCOJYGOb/tE36m/rFIs3mJ+bo9//TrAIDgRfILADmgoajY8sLV3jei5HKpXia6+HCLMtYwST9YLM
QeeA/ff7rKzcJOHAYjpNt9fj9HSMJOyYT7SFMIPjY+r1d4xGI6rV2mywUChwcjJmIbkAUoxABplu
t0ez2aT8sEw6vUhwoN1us7f3hvF4jIOBOIEDkni9u0uxWGR5OYcwtshms3Q6HQaDwbRUMQJpUpp7
pRKypyUS2GQyGbYr2+f9OM+TAJ60Ws3H/3ALAGVNr/EuUOVylNbXNmr8Lz8A/spwXbbDEEoAAAAA
SUVORK5CYII=
}] \
-style Toolbutton]]
}]\
[element "souligné" {
[widget ttk::button \
[handler formater_souligner]\
[wOptions \
-text souligné \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gQFEww7yTO4YQAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAABuklEQVQ4y6WTQWtTURBGzzf3VaEPIVJ3LQaEbHx5ae2yLkUQ
Mf6LGFsUwWIpFFdSiC0urWK6yH9Q/BEB28SXxLTUnSVkl4UNiSHURdKKNJEWD9zVHc58AzMCyG2s
vwEywBXOT2Z1ZW3by22sLz24n34eBCEXoVqN8sCEB7wNgpBKvTSyUCYkQ4DJIYFkBEHIp88ft7xx
HZrNJh/e5/G8CZ48XWRq6hpImAbCE+xMR4TMqFW+cXwMvV6PWrWOmeHM0PCNFNjws/3ziCiqEI9f
JxaLUSqV6XS6yBwmw0YlMDMk4cw4/HFIq9UimUwSpkKazSaNRoNf3Q7OHM7GCMwcR+025fJXnHPc
TAakZlMA7HzZweSdpjzB+yNwCNHr9qjX9+j3+2y+3jwtjKIK6fRDJI0TCGHUajX6/T7Zx1lmpqeR
xMHBdwqFAuVymdsLC1y67I0YQYNou7slYldjJBIJJv1JfN9nbm4W3/cpFouYM2zsCBLLL5YHMoGw
QTKJXC43iC8hdFYgif29ffL57X+u8KNMlvn5W38JXlWr0csgCInP3ODunXvnvQWAZxpe4yKwxcVY
Wl1Ze8f/8hukRn9/TCvn/wAAAABJRU5ErkJggg==
}] \
-style Toolbutton]]
}]]\
[groupe "unicode"\
[element "caractères unicodes" {
[widget ttk::button \
[handler unicode]\
[wOptions \
-text "\u221bx" \
-style Toolbutton]]
}]]\
]\
[barre "Tcl/Tk" \
[groupe "Tcl"\
[element "console" {
[widget ttk::button\
[handler console]\
[wOptions \
-command {console show}\
-style Toolbutton\
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
WXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1wIBCh8lilrtPQAAAqBJREFUSMe9lUtIVFEYx393Xt6Z
OyOU7QIFk7ZlEbWsNhWUltCmojAhhBSsTSS9H2Na7XrZE6Jd9FAJDCyqbahLbZOQYAaTY3Nn7rnv
00IbmkYjG+uDj3PPg+93/n/47oF/HArAvfu3zzqO0y6lDC1KUUVxw+FwsungodMhAMdx2ut21IdU
VV2UW5umGert62kHZgBSypCqqjx4+AgjZ5RUPKbFaNy/jx9uFFiSSqWIxbSSAKlUqmBeADByBmVq
tCTArw4UAoSBMh0sDSAKAYGfJ7kS/Z+rRoECIQRfp6ZYWVPDtq1buH6rG9d1FwQQQsyvIJ1OIyXs
2lnP2tpaWpqbUZQAUvLHmU6n51fwcWyMqW8ZWtuOcufmDdbUrubA3j1c6OwioCgogZn7SN/H832Q
Es/3cF0P27ZxHIfpqa/zKwCIqiqGYdDadoRP4+Ns3rSRtpbDZLNZ9EwGPZMhm80iDAMhBLZl43se
oWCQ6ByNWvRrEKY5M1oWUkoAXM/Nry80igCRSITyRILuG9eoqqzk5cAAly5fJRKJLA7Atm2S589S
U13Nm7fvOH7iFBUVFRxqasyfudDR+feAYDBI9917CCE4duIkABVLl7K7oSF/pqPryt8DPM9jcGiY
waHh/NrI6Cir1q0v3aJEXEMYuZI6ORHXigGKorimaYb6X/QVdeJCIxqNYpomiqK4eUA4HE729vUs
+os23375xeS5x897npqfJyd8XdelZZnStm1pWZa0LGv225S6rsvPkxP+s+dPrDPnTvYAVUC86E3+
VSWwrK5++4bqFdV1mqatKCuLLFdVdUlcmzE4m8saQohpIcxJXdfHRkc+9L8aeP0e+AKkAP93gB8R
BtRZoAZogUAgDgR83xdADjBm05xNn/8d3wFA7k6pX+fnmwAAAABJRU5ErkJggg==
}]]]
}]\
[element "NamespaceExplore" {
[widget ttk::button\
[handler NamespaceExplore]\
[wOptions \
-style Toolbutton\
-text namespace]]
}]]\
[groupe "Tk"\
[element "WidgetsExplore" {
[widget ttk::button\
[handler widgets]\
[wOptions \
-style Toolbutton\
-text widgets]]
}]\
[element "ImagesExplore" {
[widget ttk::button\
[handler images]\
[wOptions \
-style Toolbutton\
-text Images]]
}]]]}# Then the toolbar megawidget itself
megawidget create ToolBar {
v \
{*}[
typedlist create toolbar
typedlist create barre
typedlist create groupe
typedlist create element
set pseudoWidget [lindex [info level -1] end]
set is [list {type obj} {
return [expr {(![catch {info object class $obj} class]) \
&& ($class eq "::typedlist") \
&& ([$obj type] eq "$type")}]
}]
interp alias {} is {} apply $is
set tree [namespace eval [namespace current] [my getOptions [default --] -toolbar]]
set B []
menu .toolBarMenu -tearoff false
if {[is toolbar $tree]} {
foreach barre [$tree get] {
incr b
if {[is barre $barre]} {
set Barre [lassign [$barre get] barreName]
.toolBarMenu add cascade \
-label $barreName \
-menu [menu .toolBarMenu[incr m] -tearoff false]
lappend B \
[widget ttk::frame \
[gmPack -expand 0 -fill x]\
[handler $barreName \
[hVars PackInfo [hVal ""]]\
[hMethods show {} [string map [list {${barreName}} [list $barreName]] {
# protéger les variables barreName en cas d'espace dans le nom
set L [%MW ${barreName} brother]
set index [lsearch $L [%MW ${barreName} path]]
if {$index == 0} {
pack [%MW ${barreName} path] {*}[set %MW::${barreName}::PackInfo] \
-before [lindex $L $index+2]
# séparateur
pack [lindex $L $index+1] \
-before [lindex $L $index+2] -expand 0 -fill x -padx 2 -pady 2 -side top
} else {
# rechercher les fenêtres gérées par le manager (pack slaves)
set i [expr {$index-1}]
foreach w [lreverse [lrange $L 0 $index-1]] {
if {$w in [pack slaves [winfo parent [%MW ${barreName} path]]]} {
break
}
incr i -1
}
pack [%MW ${barreName} path] {*}[set %MW::${barreName}::PackInfo] \
{*}[expr {($i > 0) ? [list -after [lindex $L $i]]:""}]
# séparateur
pack [lindex $L $index+1] \
-after [%MW ${barreName} path] -expand 0 -fill x -padx 2 -pady 2 -side top
}
}] hide {} [string map [list {${barreName}} [list $barreName]] {
if {[winfo manager [%MW ${barreName} path]] eq "pack"} {
set %MW::${barreName}::PackInfo [pack info [%MW ${barreName} path]]
set L [%MW ${barreName} brother]
set index [lsearch $L [%MW ${barreName} path]]
pack forget [%MW ${barreName} path] [lindex $L [expr {$index+1}]]
}
}]]]\
[> {*}[set G []
if {$b!=1} {
.toolBarMenu$m add command \
-label "cacher la barre"\
-command [list $pseudoWidget $barreName hide]
.toolBarMenu$m add command \
-label "montrer la barre"\
-command [list $pseudoWidget $barreName show]
}
foreach groupe $Barre {
if {[is groupe $groupe]} {
set Groupe [lassign [$groupe get] groupeName]
.toolBarMenu$m add cascade \
-label $groupeName \
-menu [menu .toolGroupMenu[incr g] -tearoff false]
lappend G \
[widget ttk::frame \
[gmPack -expand 0 -fill x]\
[handler $groupeName \
[hVars PackInfo [hVal ""]]\
[hMethods show {} [string map [list {${groupeName}} [list $groupeName]] {
set L [%MW ${groupeName} brother]
set index [lsearch $L [%MW ${groupeName} path]]
if {[llength [pack slaves [winfo parent [%MW ${groupeName} path]]]]==0} {
pack [%MW ${groupeName} path] {*}[set %MW::${groupeName}::PackInfo]
pack [lindex $L $index+1] \
-after [%MW ${groupeName} path] -expand 0 -fill y -padx 2 -pady 2 -side left
return
}
if {$index == 0} {
# $b prend en compte que la première barre comprend un menu de configuration
pack [%MW ${groupeName} path] {*}[set %MW::${groupeName}::PackInfo] \
{*}[expr {$b!=1 ? [list -before [lindex $L $index+2]]:""}]
# séparateur
pack [lindex $L $index+1] \
{*}[expr {$b!=1 ? [list -before [lindex $L $index+2]]:""}]\
-expand 0 -fill y -padx 2 -pady 2 -side left
} else {
# rechercher les fenêtres gérées par le manager (pack slaves)
set i [expr {$index-1}]
foreach w [lreverse [lrange $L 0 $index-1]] {
if {$w in [pack slaves [winfo parent [%MW ${groupeName} path]]]} {
break
}
incr i -1
}
if {$i == 0} {
set i [expr {$index+2}]
foreach w [lrange $L $i end] {
if {$w in [pack slaves [winfo parent [%MW ${groupeName} path]]]} {
break
}
incr i
}
pack [%MW ${groupeName} path] {*}[set %MW::${groupeName}::PackInfo] \
-before [lindex $L $i]
# séparateur
pack [lindex $L $index+1] \
-before [lindex \$L \$i] -expand 0 -fill y -padx 2 -pady 2 -side left
} else {
pack [%MW ${groupeName} path] {*}[set %MW::${groupeName}::PackInfo] \
-after [lindex $L $i]
# séparateur
pack [lindex $L $index+1] \
-after [%MW ${groupeName} path] -expand 0 -fill y -padx 2 -pady 2 -side left
}
}
}] hide {} [string map [list {${groupeName}} [list $groupeName]] {
if {[winfo manager [%MW ${groupeName} path]] eq "pack"} {
set %MW::${groupeName}::PackInfo [pack info [%MW ${groupeName} path]]
set L [%MW ${groupeName} brother]
set index [lsearch $L [%MW ${groupeName} path]]
pack forget [%MW ${groupeName} path] [lindex $L [expr {$index+1}]]
}
}]]]\
[> {*}[set E []
.toolGroupMenu$g add command \
-label "cacher le groupe"\
-command [list $pseudoWidget $groupeName hide]
.toolGroupMenu$g add command \
-label "montrer le groupe"\
-command [list $pseudoWidget $groupeName show]
foreach element $Groupe {
if {[is element $element]} {
set Element [lassign [$element get] elementName]
set Element [subst {[subst $Element]}]
set w {*}[join $Element]
$w lappend [gmPack -padx 2 -pady 2 -expand 0 -fill y]
foreach e [$w get] {
if {[is handler $e]} {
set handler [lindex [$e get] 0]
.toolGroupMenu$g add checkbutton \
-label $elementName\
-onvalue 1 -offvalue 0\
-variable [namespace current]::$elementName \
-command [subst {
if {\[set [list [namespace current]::$elementName]] == 1} {
%MW [list $handler] show
} else {
%MW [list $handler] hide
}
}]
set [namespace current]::$elementName 1
$e lappend [hVars PackInfo [hVal ""]]
$e lappend [hMethods hide {} [string map [list {${handler}} [list $handler]] {
if {[winfo manager [%MW ${handler} path]] eq "pack"} {
set %MW::${handler}::PackInfo [pack info [%MW ${handler} path]]
set L [%MW ${handler} brother]
set index [lsearch $L [%MW ${handler} path]]
pack forget [%MW ${handler} path]
}
}] show {} [string map [list {${handler}} [list $handler]] {
set L [%MW ${handler} brother]
set index [lsearch $L [%MW ${handler} path]]
if {[llength [pack slaves [winfo parent [%MW $handler path]]]]==0} {
pack [%MW ${handler} path] {*}[set %MW::${handler}::PackInfo]
return
}
if {$index == 0} {
# $b prend en compte que la première barre comprend un menu de configuration
pack [%MW ${handler} path] {*}[set %MW::${handler}::PackInfo]
} else {
# rechercher les fenêtres gérées par le manager (pack slaves)
set i [expr {$index-1}]
foreach w [lreverse [lrange $L 0 $index-1]] {
if {$w in [pack slaves [winfo parent [%MW ${handler} path]]]} {
break
}
incr i -1
}
if {$i == 0} {
set i [expr {$index+1}]
foreach w [lrange $L $i end] {
if {$w in [pack slaves [winfo parent [%MW ${handler} path]]]} {
break
}
incr i
}
pack [%MW ${handler} path] {*}[set %MW::${handler}::PackInfo] -before [lindex $L $i]
} else {
pack [%MW ${handler} path] {*}[set %MW::${handler}::PackInfo] -after [lindex $L $i]
}
}
}]]
break
}
}
lappend E $w
}
}
set E]]]
lappend G [widget ttk::separator -orient vertical\
[gmPack -padx 2 -pady 2 -expand 0 -fill y]]
}
}
set G]]]
lappend B [widget ttk::separator -orient horizontal\
[gmPack -padx 2 -pady 2 -expand 0 -fill x]]
}
}
}
if {[is > [set childBarre0 [lindex [[lindex $B 0] get] end]]]} {
# est toujours vrai.
$childBarre0 lappend [widget ttk::menubutton -menu .toolBarMenu [gmPack -side right -expand 0 -fill y]]
}
set B]}
# pack [ToolBar .tb -toolbar $toolbar]_ -expand 0 -fill x# A unicode megawidget
typedlist create Unicode::node
typedlist create Unicode::data
namespace eval Unicode {
package require msgcat
namespace path ::msgcat
proc traductions {langref args} {
# format de dictionnaire src0 {langage0 trad0 langage1 trad1 langage2 trad2} src1 {l0 t0 l1 t1}
set D [dict create {*}$args]
set Langues $langref
dict for {src trad} $args {
dict for {langue traduction} $trad {
lappend $langue $src $traduction
lappend Langues $langue
}
lappend $langref $src $src
}
foreach langue $Langues {
mcmset $langue [set $langue]
}
}
traductions en \
{European Scripts} {fr {Scripts européens} de Eüropeisher} \
Armenian {fr Arménien de Armenisher} \
{Armenian Ligatures} {fr {Ligatures arméniennes}} \
{Latin-1 Supplement} {fr {Suppléments latin}}\
{Latin Extended-A} {fr {1ère extension du latin}}\
{Latin Extended-B} {fr {2nde extension du latin}}\
{Latin Extended-C} {fr {3ème extension du latin}}\
{Latin Extended-D} {fr {4ème extension du latin}}\
{Latin Extended Additional} {fr {Extensions du latin additionnelles}}\
{Latin Ligatures} {fr {Ligatures du latin}}\
{Fullwidth Latin Letters} {fr {Lettres latines en pleine largeur}}\
Greek {fr {Caractères grecs}}\
{Greek Extended} {fr {Caractères grecs étendus}}\
{Mathemathical Symbols} {fr {Symboles mathématiques}} \
{Arrows} {fr {Flêches}}\
{Supplemental Arrows-A} {fr {Flêches supplémentaires A}}\
{Supplemental Arrows-B} {fr {Flêches supplémentaires B}}\
{Additionnal Arrows} {fr {Flêches aditionnelles}}\
{Mathemathical Alphanumerics Symbols} {fr {Symboles alphanumériques mathématiques}}\
{Letterlike Symbols} {fr {Symboles mathématiques lettromorphes}}\
{Mathemathical Operators} {fr {Opérateurs mathématiques}}\
{Supplemental Mathemathical Operators} {fr {Opérateurs mathématiques supplémentaires}}\
{Miscellaneaous Mathematical Symbols-A} {fr {Symboles mathématiques divers A}}\
{Miscellaneaous Mathematical Symbols-B} {fr {Symboles mathématiques divers B}}\
{Geometrical shape} {fr {Formes géométriques}}\
{Additional shape} {fr {Formes additionnelles}}\
{Box Drawing} {fr {Dessin de boîtes}} \
{Blocks elements} {fr {Éléments blocs}} \
{other Symbols} {fr {Autres symboles}}\
{Miscellaneous Symbols} {fr {Symboles divers}}\
{Number and digits} {fr {Chiffres et nombres}}\
{Superscript and Subscript} {fr {Exposants et indices}}
proc uI {args} {
foreach a $args {
if {[llength $a]>1} {
lassign $a debut fin
for {set i [format %i $debut]} {$i <= [format %i $fin]} {incr i} {
lappend res [format %c $i]
}
} else {
lappend res [format %c $a]
}
}
return [data {*}$res]
}
set CharTree [node root\
[node [mc {European Scripts}] \
[node [mc Latin] \
[node [mc {Latin-1 Supplement}] [uI {0x00A1 0x00AC} {0x00AE 0x00FF}]]\
[node [mc {Latin Extended-A}] [uI {0x0100 0x017F}]]\
[node [mc {Latin Extended-B}] [uI {0x0180 0x024F}]]\
[node [mc {Latin Extended-C}] [uI {0x2C60 0x2C6C} {0x2C74 0x2C77}]]\
[node [mc {Latin Extended Additional}] [uI {0x1E00 0x1EFF}]]\
[node [mc {Latin Ligatures}]\
[uI {0xFB00 0xFB06} {0xFB13 0xFB17}\
{0xFB1D 0xFB36} {0xFB38 0xFB3C} \
0xFB3E 0xFB40 0xFB41 0xFB43 0xFB44 \
{0xFB46 0xFB4F}]]\
[node [mc {Fullwidth Latin Letters}]\
[uI {0xFF01 0xFF9F} {0xFFA1 0xFFBE}\
{0xFFC2 0xFFC7} {0xFFCA 0xFFCF}\
{0xFFD2 0xFFD7} {0xFFDA 0xFFD9}\
{0xFFE0 0xFFE6} {0xFFE8 0xFFEF}]]]\
[node [mc Greek] \
[uI {0x0370 0x0377} {0x037A 0x037E} {0x0384 0x0389} 0x038C {0x038E 0x03FF}]\
[node [mc {Greek Extended}] \
[uI {0x1F00 0x1F15} {0x1F18 0x1F1D} {0x1F20 0x1F35} {0x1F38 0x1F3D}\
{0x1F50 0x1F57} 0x1F59 0x1F5B 0x1F5D {0x1F5F 0x1F7D}\
{0x1F80 0x1FB4} {0x1FB6 0x1FC4} {0x1FC6 0x1FD3} {0x1FD6 0x1FDB} \
{0x1FDD 0x1FEF} {0x1FF2 0x1FF4} {0x1FF6 0x1FFE}]]]]\
[node [mc {Mathemathical Symbols}]\
[node [mc Arrows] [uI {0x2190 0x21FF}]\
[node [mc {Supplemental Arrows-A}] [uI {0x27F0 0x27FF}]]\
[node [mc {Supplemental Arrows-B}] [uI {0x2900 0x297F}]]\
[node [mc {Additionnal Arrows}] [uI {0x2B00 0x2B4C} {0X2B50 0x2B59}]]]\
[node [mc {Mathemathical Alphanumerics Symbols}] \
[node [mc {Letterlike Symbols}] [uI {0x2100 0x214F}]]]\
[node [mc {Mathemathical Operators}] [uI {0x2200 0x22FF}]\
[node [mc {Supplemental Mathemathical Operators}] [uI {0x2A00 0x2AFF}]]\
[node [mc {Miscellaneaous Mathematical Symbols-A}] [uI {0x27C0 0x27CA} {0x27D0 0x27EF}]]\
[node [mc {Miscellaneaous Mathematical Symbols-B}] [uI {0x2980 0x29FF}]]]\
[node [mc {Geometrical shape}] [uI {0x25A0 0X25FF}]\
[node [mc {Additional shape}] [uI {0x2B00 0x2B4C} {0x2B50 0x2B59}]]\
[node [mc {Box Drawing}] [uI {0x2500 0x257F}]]\
[node [mc {Blocks elements}] [uI {0x2580 0x259F}]]]]\
[node [mc {other Symbols}] \
[node [mc {Miscellaneous Symbols}] [uI {0x2600 0x26CD} {0x26CF 0x26E1} 0x26E3 {0x26E8 0x26FF}]]]\
[node [mc {Number and digits}] \
[node [mc {Superscript and Subscript}] [uI 0x2070 0x00B9 0x00B2 0x00B3 {0x2074 0x207F}\
0x2071 {0x2080 0x208E} {0x2090 0x2094}]]]]
proc TreeView {w tree {parent {}}} {
if {![catch {$tree type} T] && $T eq "node"} {
set SubTree [lassign [$tree get] Node]
set values [lindex $SubTree 0]
$w insert $parent end -id $Node -text $Node \
{*}[expr {![catch {$values type} T] && $T eq "data" ? [list -values [$values get]] : ""}]
foreach e $SubTree {
if {![catch {$e type} T] && $T eq "node"} {
lappend LNode {*}[TreeView $w $e $Node]
}
}
}
}
}
megawidget create ::Mega::CharTree {
> \
[widget ttk::panedwindow \
-orient vertical\
[v \
[widget ttk::treeview -height 6\
[handler tree\
[hPostConfig [list %MW tree do heading \#0 -text {Caractères unicodes}]]]\
[bScripts <<TreeviewSelect>> {
%MW view chars [%W focus]
}]\
[gmPane -weight 1 ]]\
[widget frame -width 364 \
[gmPane -weight 8]\
[handler view \
[hVars Path [hVal [my getOptions [default {}] -path]]]\
[hMethods \
chars {item} {
catch {destroy {*}[winfo children [%MW view path]]}
catch {::Mega::CharView destroy}
catch {
ttk::style layout CButton {
Toolbutton.border -sticky nswe -children {
Toolbutton.padding -sticky nswe -children {
Toolbutton.label -sticky nswe
}
}
}
set Font0 [font create -family helvetica -size 14]
ttk::style conf CButton -font $Font0 -padding {2 1}
}
megawidget create ::Mega::CharView {
v \
{*}[set L []
set nb 0
set pad [list -padx 1 -pady 1]
foreach char [%MW tree do item [%MW tree do focus] -values ] {
lappend L [widget ttk::button \
[wOptions \
-text $char\
-style CButton\
-width 2\
-command [subst -noc {
::tk::TextInsert [set {::%MW::view::Path}] [%%MW b$nb do cget -text]
focus [set {::%MW::view::Path}]
}]]\
[gmPack -expand 0 -fill none {*}$pad]\
[handler b$nb]]
incr nb
}
set M []
set nbButton [my getOptions [default 14] -nbButton]
for {set n 0} {$n<= $nb/$nbButton} {incr n} {
lappend M [widget ttk::frame \
[gmPack -expand 0 -fill both {*}$pad -anchor nw]\
[> -- {*}[lrange $L [expr {$n*$nbButton}] [expr {($n+1)*$nbButton-1}]]]]
}
set M]
}
pack [[::Mega::CharView [%MW view path].chars] rootpath] -expand 1 -fill both
}\
target {path} {
set ::%MW::view::Path $path
}]]]]]
}# Editor
# Assemble all previous megawidgets in one
megawidget create Editeur {
top\
[title Editeur]\
[v \
[widget frame \
[gmPack -expand 0 -fill x -padx 5 -pady 5]\
[v \
[mwidget ToolBar \
[wOptions -toolbar $toolbar]\
[handler toolbar]]]] \
[widget ttk::panedwindow \
-orient horizontal\
[gmPack -expand 1 -fill both]\
[handler pane]\
[> \
[widget frame\
[gmPane -weight 1]\
[handler leftpane \
[hMethods \
close {} {
%MW pane do sashpos 0 0
}\
open {{pos 300}} {
%MW pane do sashpos 0 $pos
}]\
[hPostConfig {update; ::%MW leftpane close}]]\
[v \
[widget frame -relief solid -border 1\
[gmPack -expand 0 -fill x]\
[> \
[widget ttk::label\
[gmPack -expand 1 -fill both -pady 2 -padx 10]\
[handler leftpanelabel]]\
[widget ttk::button \
[gmPack -expand 0 -fill none]\
[wOptions \
-image [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAAAmJLR0QAAKqNIzIAAAAJcEhZcwAA
CxEAAAsRAX9kX5EAAAAHdElNRQfWBAUULRDsX0JHAAAA7ElEQVQoz72QMUvDUBSFv5qCg6PgLLhU
MlToLDg4pdTxDM7S/APHtH8j/0DeKPqydPEHZHx0kKCQITo4SdWlPIeXlOoqeJbL5Tvcc7jwV0Vh
KIvzeN89tNvspDiOug2A69c7L69ZwPK3Xk+B7ITxfPCFYA7A/IoXOAyk355ITX7GBazgkpoFpAH0
uhAl3J+zB6xYwNjYHxFgbGRr+uxSE9kObxk0WCdDPvy7H7JONPhl0JSlqCg+i7cKwVLTLYMyclFR
wojTkgpBrmxTUr7FY2ND3RFHGEyv/WTcuEkDqbkBcI9x00wcpK7kP/QN44JSLNJT/ssAAAAASUVO
RK5CYII=
}] \
-style Toolbutton\
-command {
%MW leftpane close
}]]]]\
[widget frame \
[gmPack -expand 1 -fill both]\
[handler leftpanecontent]]]]\
[widget frame\
[gmPane -weight 4]\
[handler contentpane]\
[v \
[widget ttk::notebook \
[wOptions -padding 0]\
[gmPack -expand 1 -fill both -padx 5 -pady 0]\
[handler notebook \
[hVars Files [hVal {}] NumTab [hVal 1] \
ImgClose [hVal [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsSAAALEgHS3X78AAAAB3RJTUUH1gQFFCUoDIRw0QAAAaJJREFUOMulk0FLG0EYhp9ZV9zp
KnFbgzSbo80PEA8RLbSXQv5DjulRf0x7bI/5Dx5bQSh4UrxIPJq0DdsQ4kLWZZP5euhszBpzqQMD
wzvzvXzf+74Dz1zqMdCGEDgCGkDNwh3gBPjchN5Sgja0gE/1MNQlrREAEYwx3N0nnP/6nQDHTfi6
QNCG1ivP+7JXrfIniojjmIkxCLDiOKz7Pi+DgMt+n0GafsxJ1FzbNx92dvTP21uSNEWgsAHWVld5
vb3NabebAG+a0HPs3VG9UtGDKCJJU+oi7IvMCg9FOBQhyTIGwyF75bK2OpETNDa05i6OZ0UAByIc
yANigNF4jHZdrMgzgpoSYWpnPlML5vBdKQSYymyoGoCbPxARTH5+wu+CJuYBzzvoTI3gOA4CvJVF
ivdWE6UU5h9DZ57gJL5PWPd9zKO2v82NI8CG5zGeTLDBKtr4rlrV3X6fJMsK9okV0HNdwiDgRxQV
bbTxPL6KIirlMiXfR1nRDIBSlLQmDDa5Ho2waewtjfLu1pZ+4a6AgCCIwDjLuBgOl0f5fz/Ts9df
Scq9YFxk3JAAAAAASUVORK5CYII=}]] \
ImgTabNew [hVal [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gcYDhsksJX0swAAAB10RVh0Q29tbWVudABDcmVhdGVk
IHdpdGggVGhlIEdJTVDvZCVuAAACE0lEQVQ4y3WSwU4UQRCGv+rumZWFxQVEXcTVGAU86Ekvhmy8
ePEJfALeQg8mJIQ34Gg8+QjevZp44cCaiIkISxDYAXaXmdnp8sCMTDZYyZ9OulNf/VXVwn/i7Mei
ERPeRvWZ9+ev1McPQJ2Yyq61E59tMPXFuut7ArC2vroCbJQB1co5zUaHpeYmU+PbONkDwLp63wbT
P11465N1kx9lbX11ZWnp8UZruXWZrQnGb5HtvwbOAaW+eAhAd2sGEJSAg/TtbwdstJZbHJ8c0R/0
AMVIj5r7SpWU+sIugoLGANQXdlEg+t7kYTMZd4AH6A96UhgwpBqYUwPKha6OYdoJTQ4YkVEl0MrE
C6L2PIhcdqcQte8wVnuOoGKA4ai8hlnq5zIvcwoGsbOXXkRALNbNKlIbGiAuKQFJPWES+0Yy8E9S
FYvPjojaTaJ2ExELaugcVv23zd6JAwaAlARYSbIZc8pTW6u+z7rte2OV+psscI6ofd+O3XyXhPIo
rjfuHjigD5iixRxilMDEWUO8VkwQfjgL4q4jUfy1lxxF08PUTyaZt8cOiP4N/yKkACnOJv6GT31d
ROatoCjivQYKJgXTdcB+UTXfgikBFQxKKKpagDMQmw/8jwM6pWVrCVYM3l6ARUvuyAE7DtjOE+SK
v1Lc+SvcJUDHAb9GetdSYtEWI2cBiBywU7KvJftFso68DfMCHuj/Bd7S7JLHRwjTAAAAAElFTkSu
QmCC
}]]]\
[hMethods \
add {name} {
variable Files
variable NumTab
variable ImgClose
set nbTab [%MW notebook do index end]
if {[file extension $name] eq ".tcl" || [file extension $name] eq ".oo"} {
%MW notebook do insert [expr {$nbTab-1}] \
[[set mPath [scrollText [%MW notebook path].scrollText[incr NumTab] -type stext]] rootpath] \
-text "[file tail $name] " -image $ImgClose -compound right
%MW notebook do select [expr {$nbTab-1}]
[%MW notebook objSelected] text do margin configure number -visible yes
[%MW notebook objSelected] text do margin configure fold -visible yes
[%MW notebook objSelected] text do lexer set tcl
} elseif {[file extension $name] eq ".htnstw"} {
namespace eval :: {
catch {
source htnstw.tcl.oo
}
}
%MW notebook do insert [expr {$nbTab-1}] \
[[set mPath [scrollText [%MW notebook path].scrollText[incr NumTab] -type text]] rootpath] \
-text "[file tail $name] " -image $ImgClose -compound right
%MW notebook do select [expr {$nbTab-1}]
} elseif {[file extension $name] eq ".c" || [file extension $name] eq ".cpp"} {
%MW notebook do insert [expr {$nbTab-1}] \
[[set mPath [scrollText [%MW notebook path].scrollText[incr NumTab] -type stext]] rootpath] \
-text "[file tail $name] " -image $ImgClose -compound right
%MW notebook do select [expr {$nbTab-1}]
[%MW notebook objSelected] text do margin configure number -visible yes
[%MW notebook objSelected] text do margin configure fold -visible yes
[%MW notebook objSelected] text do lexer set cpp
} else {
%MW notebook do insert [expr {$nbTab-1}] \
[[set mPath [scrollText [%MW notebook path].scrollText[incr NumTab] -type text]] rootpath] \
-text "[file tail $name] " -image $ImgClose -compound right
}
# %MW notebook do select [expr {$nbTab-1}]
lappend Files $name
return [%O createHandler text$NumTab $mPath]
}\
objSelected {} {
return [string range [%MW notebook do select] 0 end-1]
}\
Reperer {} {
set nbTab [%MW notebook do index end]
set nb 0
for {set i 10} {$nb ne {}} {incr i 1} {
set nb2 [%MW notebook do index @$i,20]
if {$nb2 !=$nb} {
set ::%MW::croix($nb) [list [expr {$i-20}] [expr {$i-8}] 10 22]
set nb $nb2
}
}
}] [hPostConfig {::%MW notebook do tab 0 -image ${::%MW::notebook::ImgTabNew}}]]\
[bScripts <ButtonPress> {
%MW notebook Reperer
update
set nbTab [%MW notebook do index end]
for {set i 0} {$i<$nbTab-1} {incr i} {
if {"%x" > [lindex [set ::%MW::croix($i)] 0] && "%x" < [lindex [set ::%MW::croix($i)] 1] \
&& "%y" > [lindex [set ::%MW::croix($i)] 2] && "%y" < [lindex [set ::%MW::croix($i)] 3]} {
# On peut fermer l'onget
%MW notebook do forget $i
# detruire la fenêtre ? Comment
# recalculer les positions
%MW notebook Reperer
}
}
} <<NotebookTabChanged>> {
event generate %W <<HiliteRemove>>
} <<HiliteRemove>> {
set wSelected [%W select]
set mwSelected [string range $wSelected 0 end-1]
foreach w [%W tabs] {
set mw [string range $w 0 end-1]
$mw text do tag remove hilite 0.0 end
set ::${mw}::mwHasFocus $mwSelected
}
focus [$mwSelected text path]
}]\
[> \
[mwidget scrollText\
[handler text]\
[gmNotebook -text *]]]]]]]]]}
# Test
Editeur .edit
wm protocol [.edit rootpath] WM_DELETE_WINDOW {
destroy .
exit
}
wm withdraw .
# console show
.edit toolbar obj ouvrir config -command {
if {[set F [tk_getOpenFile]] ne {}} {
set cursor [.edit_ cget -cursor]
.edit_ conf -cursor wait
[.edit notebook path] conf -cursor wait
[set NBS [[string range [.edit notebook do select] 0 end-1] text path]] conf -cursor wait
set Hand [.edit notebook add $F]
set fid [open $F r]
[.edit $Hand obj] text do delete 0.0 end
if {[file extension $F] eq ".htnstw"} {
::htnstw insert [[.edit $Hand obj] text path] end [read $fid]
[.edit $Hand obj] text do tag raise sel
} else {
[.edit $Hand obj] text do insert end [read $fid]
}
close $fid
set wSelected [.edit notebook do select]
set mwSelected [string range $wSelected 0 end-1]
tk::TextSetCursor [$mwSelected text path] 0.0
focus [$mwSelected text path]
.edit_ conf -cursor $cursor
[.edit notebook path] conf -cursor $cursor
$NBS conf -cursor $cursor
}
}
.edit toolbar obj sauverSous config -command {
if {[file extension [set f [string trim [.edit notebook do tab [.edit notebook do select] -text]]]] eq ".htnstw"} {
set F [tk_getSaveFile -defaultextension ".htnstw" -initialdir [pwd] -initialfile $f ]
if {$F ne {}} {
set wSelected [.edit notebook do select]
set mwSelected [string range $wSelected 0 end-1]
::htnstw::save [$mwSelected text path] $F
}
} else {
set F [tk_getSaveFile -initialdir [pwd] -initialfile $f ]
if {$F ne {}} {
set wSelected [.edit notebook do select]
set mwSelected [string range $wSelected 0 end-1]
set fid [open $F w]
puts $fid [$mwSelected text do get 0.0 end]
close $fid
}
}
}
.edit toolbar obj imprimer config -command {
#don't work
if {$::tcl_platform(platform) ne "windows"} {
error "printing is only supported under Windows"
}
set filename c:/temp/[file tail [wm title .]]
set f [open $filename w]
chan configure $f -encoding utf-8 -blocking 0
chan puts $f \ufeff[[string range [.edit notebook do select] 0 end-1] text do get 1.0 end]
chan close $f
exec cmd /c start /min notepad /p $filename &
file delete $filename
}
.edit toolbar obj undo config -command {
[.edit notebook objSelected] text do edit undo
}
.edit toolbar obj redo config -command {
[.edit notebook objSelected] text do edit redo
}
.edit toolbar obj coller config -command {
event generate [[.edit notebook objSelected] text path] <<Paste>>
}
.edit toolbar obj couper config -command {
event generate [[.edit notebook objSelected] text path] <<Cut>>
}
.edit toolbar obj copier config -command {
event generate [[.edit notebook objSelected] text path] <<Copy>>
}
[.edit toolbar obj] unicode config -command {
set wSelected [.edit notebook do select]
set mwSelected [string range $wSelected 0 end-1]
destroy [winfo child [.edit leftpanecontent path]]
catch {pack [[::Mega::CharTree [.edit leftpanecontent path].uc -path [$mwSelected text path]] rootpath] -expand 1 -fill both}
.edit leftpanelabel config -text "Charactères unicodes"
[.edit leftpanecontent path].uc tree config -show tree
bind [.edit notebook path] <<NotebookTabChanged>> +[subst -noc -nov {
set wSelected [.edit notebook do select]
set mwSelected [string range $wSelected 0 end-1]
[.edit leftpanecontent path].uc view target [$mwSelected text path]
puts [$mwSelected text path]
}]
::Unicode::TreeView [[.edit leftpanecontent path].uc tree path] $::Unicode::CharTree
.edit leftpane open 364
}
.edit toolbar obj policeName do set [lindex [[.edit text obj] text do cget -font] 0]
.edit toolbar obj policeSize do set [lindex [[.edit text obj] text do cget -font] end]
.edit toolbar obj policeSize config -postcommand {
#don't work
.edit text obj text config -font [font create -family [lindex [[.edit text obj] text do cget -font] 0]\
-size [lindex [[.edit text obj] text do cget -font] end]]
}
# A listbox with images
megawidget create ListText {
v \
[widget ttk::frame \
[@ \
[widget ttk::scrollbar \
[wOptions \
-orient vertical \
-command {%MW listText do yview}]\
[handler sy]\
[gmPack -side right -expand 0 -fill y]]\
[widget ttk::scrollbar \
[wOptions -orient horizontal \
-command {%MW listText do xview}]\
[handler sx]\
[gmPack -side bottom -expand 0 -fill x]]\
[widget text \
[wOptions \
-width [my getOptions [default 50] -nb]\
-xscrollcommand {%MW sx do set}\
-yscrollcommand {%MW sy do set}\
-cursor arrow\
-wrap none]\
[handler listText \
[hPostConfig [subst -nov {
proc ::%MW::updatelist {} {
set ::%MW::i -1
%MW listText do delete 0.0 end
set ::%MW::colors [list [my getOptions [default yellow white] -alternativebackground]]
set alterner \[llength ${::%MW::colors}\]
foreach e \[set [my getOptions [default {}] -listvariable]\] {
lassign $e img text
set ::%MW::BG \[lindex ${::%MW::colors} \[expr {${::%MW::i}%$alterner}\]\]
set IMG \[%MW listText do image create end -image $img -align center -padx 5\]
%MW listText do tag conf $IMG -background ${::%MW::BG}
%MW listText do insert end \\t$text\\n e\[incr {::%MW::i}\]
%MW listText do tag conf e${::%MW::i} -background ${::%MW::BG}
%MW listText do tag bind e${::%MW::i} <Any-Enter> "%MW listText do tag conf e\${::%MW::i} -background \[%MW listText do cget -selectbackground\] -foreground \[%MW listText do cget -selectforeground\]; "
%MW listText do tag bind e${::%MW::i} <Any-Leave> "%MW listText do tag conf e\${::%MW::i} -background ${::%MW::BG} -foreground \[%MW listText do cget -foreground\]"
%MW listText do tag bind e${::%MW::i} <ButtonPress-1> "
event generate \[%MW rootpath\] <<ListTextSelect>> -data \\\"\[%MW listText do get {*}\[%MW listText do tag range e\${::%MW::i}\]-1c\]\\\"
"
}
}
proc ::%MW::vartrace {n0 n1 op} {
::%MW::updatelist
}
trace add variable [my getOptions [default {}] -listvariable] write ::%MW::vartrace
::%MW::updatelist
}]]]\
[gmPack -expand 1 -fill both]]\
]]
}
megawidget create Filtre {
v \
[set ::%MW::Liste [set [my getOptions [default {}] -listvariable]]
widget ttk::frame \
[gmPack -fill x -expand 0 -padx 5 -pady 5]\
[> \
[widget ttk::entry \
[handler pattern]\
[gmPack -expand 1 -fill x -padx {0 5}]\
[bScripts <KeyPress-Return> {%MW filtrer do invoke}]
]\
[widget ttk::button \
-text [my getOptions [default {Filtrer}] -text] \
-command {
%MW filtrer liste
}\
[gmPack -expand 0]\
[handler filtrer\
[hMethods liste {args} [subst {
set ::%MW::Liste \[lsearch -index 1 -glob -all -inline \
\[set [my getOptions [default {}] -listvariable]\] *\[%MW pattern do get\]*\]
}]]\
[hPostConfig {trace add variable [my getOptions [default {}] -listvariable] write ::%MW::filtrer::liste}]]]]]\
[mwidget ListText \
[handler liste]\
[wOptions -listvariable ::%MW::Liste -alternativebackground [list AntiqueWhite1 AntiqueWhite3 ]]]}
set ::L []# let's try it with the currents images known by Tk
foreach i [image names] {
lappend L [list $i $i]
}
pack [[Filtre .lt -listvariable ::L] rootpath] -expand 1 -fill bothLV Once it has stablized, it would be great if it were contributed to the tklib for general access.
FM Thanks for the invitation. Do you understand how it works ? Do you try to play with it at home ? I hope so. You should know that every suggestion is welcome.
For the stabilisation, I 'm not sure right now. I'm still exploring the possibilities. If I could get some goods critics, some goods advices, and a some little help, it will stabilize.
PYK 2014-11-06: In an attempt to remedy the corruption mentioned on analogy between html markup and typedlist, I've made some modifications to the code above, basically, going through and making sure values are properly enclosed in a list where code is being generated, until it got to the point that opening the example on that page , saving it, opening that saved file and saving it again produces identical data. FM, does that fix the corruption you were talking about?