This is another megawidget framework. It uses [typedlist] package. It's a class which create an megawidget as an ensemble command. There is a an example below. It's an editor with tabs, unicode chars, toolbar, and searchbox It should look like this : [http://img63.imageshack.us/img63/3798/editeurdemo.png] ** package code :** ====== 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 -noc { if {\$args eq {}} { return ${path} } else { $path {*}\$args } }] proc ::${rootPath}::${handler}::configure {args} "${path}_ configure {*}\$args" proc ::${rootPath}::${handler}::do {args} "${path}_ {*}\$args" proc ::${rootPath}::${handler}::bind {event script} [subst -noc { ::bind ${path}_ \$event \$script }] proc ::${rootPath}::${handler}::parent {args} [subst -noc { return [winfo parent ${path}_] }] proc ::${rootPath}::${handler}::brother {args} [subst -noc { return [winfo children [winfo parent ${path}_]] }] proc ::${rootPath}::get::${path}::handler {args} [subst -noc { return $handler }] proc ::${rootPath}::${handler}::space {args} [subst -noc { return ::${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) ${rootPath}]; # substitution MegaWidget set Tree [regsub -all -- %${rootPath} $Tree %MW]; # unsubstitute protected MegaWidget set Tree [regsub -all -- %O $Tree [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 -noc { return ${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 -noc { if {\$option in [list namespace caller class filter method namespace next object target]} { return [dict get {$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 \[$rootPath get typedlists\] { if {\[catch {\$l destroy} err\]} { puts stderr "erreur de destruction de la liste \$l message: \$err, rootpath $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 if {[$o type] eq "wOptions"} { # Options de création de la fenêtre $Top configure {*}[$o get] } if {[$o type] eq "grid"} { wm grid $Top {*}[$o get] } if {[$o type] eq "title"} { wm title $Top [$o get] } if {[$o type] eq "resizeable"} { wm resizeable $Top {*}[$o get] } if {[$o type] eq "geometry"} { wm geometry $Top [$o get] } if {[$o type] eq "attributes"} { foreach {attr val} [$o get] { wm attributes $Top $attr $val } } if {[$o type] eq "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" } } if {[$o type] eq "minsize"} { lassign [$o get] W H wm minsize $Top $W $H } if {[$o type] eq "maxsize"} { lassign [$o get] W H wm maxsize $Top $W $H } if {[$o type] eq "overrideredirect"} { wm overrideredirect $Top [$o get] } if {[$o type] eq "howToReturn"} { # commande à retourner set ::${rootPath}::returnCommand [$o get] } if {([$o type] eq ">")\ ||([$o type] eq "<")\ ||([$o type] eq "v")\ ||([$o type] eq "^")\ ||([$o type] eq "@")} { 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] eq ">") \ || ([$tree type] eq "<") \ || ([$tree type] eq "v") \ || ([$tree type] eq "^") \ || ([$tree type] eq "@"))} { 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 if {[$e type] eq "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 if {[$o type] eq "wOptions"} { set wOptions [$o get] } if {[$o type] eq "gmPack"} { set gmPack [$o get] set WidgetTree(${path}_,gm) Pack } if {[$o type] eq "gmGrid"} { set gmGrid [$o get] set WidgetTree(${path}_,gm) Grid } if {[$o type] eq "gmNotebook"} { set gmNotebook [$o get] set WidgetTree(${path}_,gm) Notebook set WidgetTree(${path},gm) Notebook } if {[$o type] eq "gmTable"} { set gmTable [$o get] set WidgetTree(${path}_,gm) Table set WidgetTree(${path},gm) Table } if {[$o type] eq "gmPane"} { set gmPane [$o get] set WidgetTree(${path}_,gm) Panewindow set WidgetTree(${path},gm) Panewindow } if {[$o type] eq "gmCanvas"} { set gmCanvas [$o get] set WidgetTree(${path}_,gm) Canvas set WidgetTree(${path},gm) Canvas } if {[$o type] eq "gmText"} { set gmText [$o get] set WidgetTree(${path}_,gm) Text set WidgetTree(${path},gm) Text } if {[$o type] eq "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 -noc { if {\$args eq {}} { return ${path} } else { $path {*}\$args } }] proc ::${rootPath}::${handler}::configure {args} "${path}_ configure {*}\$args" proc ::${rootPath}::${handler}::do {args} "${path}_ {*}\$args" proc ::${rootPath}::${handler}::bind {event script} [subst -noc { ::bind ${path}_ \$event \$script }] proc ::${rootPath}::${handler}::parent {args} [subst -noc { return [winfo parent ${path}_] }] proc ::${rootPath}::${handler}::brother {args} [subst -noc { return [winfo children [winfo parent ${path}_]] }] proc ::${rootPath}::get::${path}::handler {args} [subst -noc { return $handler }] proc ::${rootPath}::${handler}::space {args} [subst -noc { return ::${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} set $var $v } else { namespace eval ::${rootPath}::${handler} 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 "unknow 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 } elseif {[$e type] eq "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 if {[$o type] eq "wOptions"} { set wOptions [$o get] } if {[$o type] eq "gmPack"} { set gmPack [$o get] set WidgetTree($path,gm) Pack } if {[$o type] eq "gmGrid"} { set gmGrid [$o get] set WidgetTree(${path},gm) Grid } if {[$o type] eq "gmNotebook"} { set gmNotebook [$o get] set WidgetTree($path,gm) Notebook } if {[$o type] eq "gmTable"} { set gmTable [$o get] set WidgetTree($path,gm) Table } if {[$o type] eq "gmPane"} { set gmPane [$o get] set WidgetTree($path,gm) Panewindow } if {[$o type] eq "gmCanvas"} { set gmCanvas [$o get] set WidgetTree($path,gm) Canvas } if {[$o type] eq "gmText"} { set gmText [$o get] set WidgetTree($path,gm) Text } if {[$o type] eq "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 } } if {[$o type] eq "bScripts"} { set bScripts [] foreach {bSeq bSc} [$o get] { lappend bScripts $bSeq $bSc } } if {[$o type] eq "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 $path" proc ::${rootPath}::${handler}::configure {args} "$path configure {*}\$args" proc ::${rootPath}::${handler}::do {args} "$path {*}\$args" proc ::${rootPath}::${handler}::bind {event script} [subst -noc { ::bind $path \$event \$script }] proc ::${rootPath}::${handler}::parent {args} [subst -noc { return [winfo parent $path] }] proc ::${rootPath}::${handler}::brother {args} [subst -noc { return [winfo children [winfo parent $path]] }] proc ::${rootPath}::get::${path}::handler {args} [subst -noc { return $handler }] proc ::${rootPath}::${handler}::space {args} [subst -noc { return ::${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 } if {([$o type] eq ">")\ ||([$o type] eq "<")\ ||([$o type] eq "v")\ ||([$o type] eq "^")\ ||([$o type] eq "@")} { 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 } } } elseif {[$e type] eq "TkpItem"} { $path create {*}[$e get] continue } elseif {[$e type] eq "spanTable"} { $path span {*}[$e get] continue } elseif {[$e type] eq "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**** ====== 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 [subst -noc {[%MW rootpath]}]] -cancelButtonCommand]\ -image [my getOptions [default -- $ImgVide] -cancelButtonImage] \ -compound [my getOptions [default -- text] -cancelButtonCompound]\ {*}$buttonWidth] \ [handler cancelButton]\ [gmPack -expand 0 -fill y {*}$Pad]]]]]} # pack [[SearchBox .sb] rootpath]; # the rootpath subcommand give the real path of the widget ====== ****# 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 \ { 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] <> wm withdraw .sb0_ }] wm protocol .sb0_ WM_DELETE_WINDOW [subst -noc { event generate [[set ::%MW::mwHasFocus] text path] <> 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] } } } } <> { %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 {} [subst -noc { # 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 {} [subst -noc { 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 {} [subst -noc { 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 {} [subst -noc { 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 "[namespace current]::$elementName"\] == 1} { %MW $handler show } else { %MW $handler hide } }] set "[namespace current]::$elementName" 1 $e lappend [hVars PackInfo [hVal ""]] $e lappend [hMethods hide {} [subst -noc { 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 {} [subst -noc { 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 <> { %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 { %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 } } } <> { event generate %W <> } <> { 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] <> } .edit toolbar obj couper config -command { event generate [[.edit notebook objSelected] text path] <> } .edit toolbar obj copier config -command { event generate [[.edit notebook objSelected] text path] <> } [.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] <> +[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]] } ====== <>Category Object Orientation|Category Package