tcl/tk in Perl


Binio

Erfahrenes Mitglied
Gibt es die möglichkeit mein Script:

Code:
#!/usr/bin/wish -f

# =====================================================================================
#
#       Filename:  regulaere_ausdruecke_darstellen.tcl
#
#    Description:  Regul\Uffffffff Ausdr\Uffffffffraphisch und textuell darstellen
#
#        Version:  1.0
#        Created:  7.03.2008
#       Revision:  none
#       Compiler:  Tcl/Tk
#
#         Author:  Robert Slowikowski admin@binnio.de
#        Company:  Fachhochschule S\Ufffffffffalen, Iserlohn
#
#   Mit diesem Programm k\Uffffffffn Sie ihre Regul\Uffffffffn Audr\Uffffffffraphisch oder textuell
#   darstellen. Es gibt die m\Uffffffffchkeit diese zu speichern und zu ein anderen Zeitpunkt
#   wieder zu laden und diesen dann weiter zu bearbeiten.
# =====================================================================================

# Packet welches es erlaubt Jpeg, PNG, Tiff, PPM, ICO, XPM, XBM oder PCX einzubinden
set packetResult [catch { package require Img }]
if {$packetResult != 0} {
    wm withdraw .
    toplevel .fehler
    wm title .fehler "Fehler"
    pack [ message .fehler.meldung -width 300 -text "Es fehlt Ihnen das Packet \
        \"Img\" um graphische Elemente darzustellen \n\n Die Version 1.3 \
        ist bei Sourceforge erh\Ufffffffflich, dort hei\Uffffffff sie wegen eines Namenskonflikts \
        \"Tkimg\". Unter Debian hei\Uffffffff das Packet \"libtk-img\"." ] -side top
    pack [ button .fehler.ok -text "Ende" -command {exit} ] -side top
} else {
    # Hauptfenster nicht \Ufffffffferbar in seiner Gr\Uffffffff
    wm resizable . 0 0
    
    # Verlaufsliste
    toplevel .th
    
    wm title . "Regul\Uffffffff Ausdr\Uffffffffarstellen"
    wm title .th "Verlaufsliste"

    wm geometry . +100+100
    wm geometry .th +815+100

    #===========Prozeduren===========Start
    proc dateidialog {} {
        global datei
        
        # Dateitypen festlegen
        set filetypes { \
            {"Alle Dateien" *} \
            {"Textdateien" {.txt .TXT} } \
            {"Tcl-Dateien" { .tcl .TCL .tk .TK} }
        }
        
        # \Ufffffffffnendialog
        set datei [tk_getOpenFile \
            -initialdir [pwd] \
            -title "Datei \Uffffffffen..." \
            -filetypes $filetypes \
            -defaultextension .txt \
            -parent .]
        
        # In die proc einlesen gehen
        einlesen
    }

    proc einlesen {} {
        global datei
        global historyvar

        # ...wenn $datei ungleich leer
        if {$datei !=""} then {
            # Variable sicherheitshalber leeren
            set thefile ""
            
            # Dateigr\Uffffffffbestimmen
            set filesize [file size $datei]
            
            # Datei \Uffffffffen zum Lesen und Schreiben
            set thefile [open $datei "r+"]
            
            # Datei in die Variable "inhalt" mit der Dateigr\Uffffffffeinlesen
            set inhalt [read $thefile $filesize]
            
            # Inhalt der Variable "inhalt" in die Variable "historyvar" kopieren
            set historyvar $inhalt
            
            # Kanal schlie\Uffffffffn
            close $thefile
            
            # Kopf des Hauptfenster \Uffffffffern
            wm title . $datei
        }
    }

    proc speichern_unter {} {
        global historyvar
        
        # Dateitypen festlegen
        set filetypes { \
            {"Alle Dateien" *} \
            {"Textdateien" {.txt .TXT} } \
            {"Tcl-Dateien" { .tcl .TCL .tk .TK} }
        }
        
        # Speicherndialog
        set datei [tk_getSaveFile -initialdir [pwd] \
            -title "Speichern unter ..." \
            -filetypes $filetypes \
            -defaultextension .txt \
            -parent .]
        if { $datei == "" } {
            return; #Es wurde Abbruch gedr\Uffffffff        }
        
        # Datei \Uffffffffen zum Schreiben
        set x [catch {set fid [open $datei "w+"]}]
        
        # Schreibe in die Datei
        set y [catch {puts $fid $historyvar}]
        
        # Kanal schlie\Uffffffffn
        set z [catch {close $fid}]
        
        # \Ufffffffferpr\Uffffffffob alles gut ging und die Datei existiert,
        # lesbar und kein Verzeichnis ist
        if { $x || $y || $z || ![file exists $datei] || ![file isfile $datei] || \
        ![file readable $datei] } {
            tk_messageBox -parent . -icon error -message \
                "Ein error endstand w\Uffffffffend des speichern in \"$datei\""
        } else {
            tk_messageBox -parent . -icon info -message \
                "Speichervorgang erfolgreich"
        }
    }
    #===========Prozeduren===========Ende

    #===========Men\Uffffffffe===========Start
    pack [frame .mbar -relief groove -bd 3] -side top -expand yes -fill x
    pack [menubutton .mbar.datei -text "Datei" -menu .mbar.datei.menu] -side left
    
    menu .mbar.datei.menu
    .mbar.datei.menu add command -label "\Ufffffffffnen Strg+o" -command {dateidialog}
    bind all <Control-o> {dateidialog}
    .mbar.datei.menu add command -label "Speichern unter ... Strg+s" \
        -command {speichern_unter}
    bind all <Control-s> {speichern_unter}
    .mbar.datei.menu add command -label "Beenden" -command {exit}
    #===========Men\Uffffffffe===========Ende

    #===========Haupt===========Start    
    pack [frame .auswahl -relief groove -bd 2] -side left -anchor n
    pack [label .auswahl.label -text "Regul\Uffffffffr Ausdruck"] -side left
    pack [entry .auswahl.eingabe -width 50 -textvariable eingabevar] -side left
    pack [checkbutton .auswahl.cb1 -text "Graphisch" -variable grafikvar] -side left
    pack [checkbutton .auswahl.cb2 -text "Textuell" -variable textvar] -side left
    pack [button .auswahl.los -text "LOS" -padx 20 -command {
        global eingabevar
        global grafikvar
        global textvar
        
        # ... wenn Eingabefeld nicht leer ist, d.h. mindestens 1 Zeichen enth\Uffffffff
        if { [string length $eingabevar] > 0 } {
            # ... wenn die Verlaufsliste geschlossen wurde
            if { [ winfo exists .th ] == 0 } {
                toplevel .th
                wm title .th "Verlaufsliste"
                wm geometry .th +815+100
                
                pack [label .th.lhistory -text "Ihre Aktion:"] -side top
                pack [frame .th.aktion -relief groove -bd 2] -side top -anchor n
                pack [button .th.aktion.bladen -text "In Eingabe laden" \
                    -padx 20 -command { set eingabevar \
                    "[.th.historylist get active]" }] -side left
                pack [button .th.aktion.bloeschen -text \
                    "Aus der Verlaufsliste l\Uffffffffen" -padx 20 -command { \
                    .th.historylist delete \
                    [.th.historylist index active] }] -side left
                pack [listbox .th.historylist -width 50 \
                    -height 20 -listvariable historyvar] -side bottom
                

                bind .th.historylist <Double-Button-1> { \
                    set eingabevar "[.th.historylist get active]"};
                focus .th.historylist
            }


            # ... wenn graphisch angezeigt werden soll
            if { $grafikvar == 1 } {
                set catchResult [catch {exec perl [pwd]/re_graph.pl \
                    -o temp.png $eingabevar } bildResult]
                # ... wenn der exec Befehl ohne Fehler war
                if {$catchResult == 0} {
                    # ... wenn das Topfenster .bild nicht Existiert
                    if { [ winfo exists .bild  ] == 0 } {
                        toplevel .bild
                        wm title .bild "Graphische Darstellung"
                        wm geometry .bild +100+220

                        pack [label .bild.ergbild] -side left
                    }
                    set foto [image create photo -file [pwd]/temp.png ]
                    .bild.ergbild configure -image $foto
                }
            } else {
                destroy .bild            
            }
            
            # ... wenn textuell angezeigt werden soll
            if { $textvar == 1 } {
                set catchResult [catch {exec [pwd]/regex.sh \
                    $eingabevar } Result]
                # ... wenn der exec Befehl ohne Fehler war
                if {$catchResult == 0} {
                    # ... wenn das Topfenster .text nicht Existiert
                    if { [ winfo exists .text ] == 0 } {
                        toplevel .text
                        wm title .text "Textuelle Darstellung"
                        wm geometry .text +400+200
                                    
                        pack [scrollbar .text.yscr \
                            -orient vertical \
                            -command {.text.ergtext yview}] \
                            -side right -anchor center -fill y \
                            -expand 0 -padx 0 -pady 0 -ipadx 0 \
                            -ipady 0
                        pack [text .text.ergtext -yscrollcommand { \
                            .text.yscr set}] -side left
                    }
                    .text.ergtext delete 1.0 end            
                    .text.ergtext insert 1.0 $Result
                    wm resizable .text 0 0
                }
            } else {
                destroy .text        
            }
            
            # Wenn es ungleich dem letzten regul\Uffffffffn Ausdruck \
            in der Verlaufsliste ist, hinzuf\Uffffffff            if { [.th.historylist get end] != $eingabevar } {
                .th.historylist insert end $eingabevar
            }
        }
    }] -side left
    #===========Haupt===========Ende

    #===========Verlaufsliste===========Start
    pack [label .th.lhistory -text "Ihre Aktion:"] -side top

    pack [frame .th.aktion -relief groove -bd 2] -side top -anchor n
    pack [button .th.aktion.bladen -text "In Eingabe laden" -padx 20 -command { \
        set eingabevar "[.th.historylist get active]" }] -side left
    pack [button .th.aktion.bloeschen -text \
        "Aus der Verlaufsliste l\Uffffffffen" -padx 20 -command { \
        .th.historylist delete [.th.historylist index active] }] -side left
    pack [listbox .th.historylist -width 50 -height 20 -listvariable historyvar] \
        -side bottom
    
    # Zu Demozwecken
    .th.historylist insert end {^a(b|z$)} {^(a|b)(c|d)$} {^(a(b|c)|def)$}
    
    bind .th.historylist <Double-Button-1> { \
        set eingabevar "[.th.historylist get active]"};

    focus .th.historylist
    #===========Verlaufsliste===========Ende

    update
    focus -force .auswahl.eingabe

}

schnell und ohne viel am Inhalt zu ändern Perl tauglich zu machen ?
Würde mich über jeden Tipp sehr freuen.

Robert