A small editor in 8.5.0

HE 2007-12-26: I wrote this small editor to try the new peer functionality of the text widget and the new ttk::notebook.

Attributes

license
HE

Changes

HJG: Added an "About"-command.


AM 2009-10-03: Here is a small example of how to add formatting to the text widget: Editing with different fonts


package require Tk

set title {edit 0.0}
global dateien ;# Array with index = tab and data = filename

#-------#
# procs #
#-------#
proc textfenster {mframe {master {}}} {
    if {$master eq {}} {
        text [set mframe].t -bg white -xscrollcommand [
            list [set mframe].x set] -yscrollcommand [
            list [set mframe].y set] -wrap word
    } else {
        $master peer create [set mframe].t
    }
    scrollbar [set mframe].x -orient horizontal -command [
        list [set mframe].t xview] -width 12
    scrollbar [set mframe].y -orient vertical   -command [
        list [set mframe].t yview] -width 12
    grid configure [set mframe].t -column 0 -row 0 -sticky nsew
    grid configure [set mframe].x -column 0 -row 1 -sticky ew
    grid configure [set mframe].y -column 1 -row 0 -sticky ns
    grid columnconfigure [set mframe] 0 -weight 1
    grid columnconfigure [set mframe] 1 -weight 0
    grid rowconfigure    [set mframe] 0 -weight 1
    grid rowconfigure    [set mframe] 1 -weight 0
    return [set mframe].t
}

proc newTab {{filename {}}} {
    set pw [ttk::panedwindow .nb.pw[llength [.nb tabs]] -orient vertical]
    frame $pw.f1
    frame $pw.f2
    $pw add $pw.f1
    $pw add $pw.f2

    textfenster $pw.f1
    textfenster $pw.f2 $pw.f1.t
    $pw.f1.t configure -undo 1

    pack $pw -expand 1 -fill both

    if {$filename eq {}} {
        .nb add $pw
    } else {
        .nb add $pw -text [file tail $filename]
        set fid [open $filename r]
        $pw.f1.t insert end [read $fid]
        close $fid
        $pw.f1.t edit modified 0
    }
    set ::dateien($pw) $filename
    .nb select $pw
    return $pw
}

proc menu_new {} {
    newTab
    return
}

proc menu_open {} {
    set filename [tk_getOpenFile -title $::title]
    if {$filename eq {}} {
        return
    }
    newTab $filename
    return
}

proc menu_close {{pw {}}} {
    if {$pw eq {}} {
            set pw [.nb select]
    }
    if {[$pw.f1.t edit modified]} {
        if {[tk_messageBox -title $::title -type yesno -icon info -message "The contents of the tab isn't saved yet. Save now?"] eq {yes}} {
            menu_save $pw
        }
    }
    .nb forget $pw
    destroy $pw
    unset ::dateien($pw)
    return
}

proc menu_save {{pw {}}} {
    if {$pw eq {}} {
        set pw [.nb select]
    }
    if {$::dateien($pw) eq {}} {
        menu_saveAs $pw
    }
    set fid [open $::dateien($pw) w]
    puts -nonewline $fid [$pw.f1.t get 1.0 end]
    close $fid
    $pw.f1.t edit modified 0
    return
}

proc menu_saveAs {{pw {}}} {
    if {$pw eq {}} {
        set pw [.nb select]
    }
    set filename [tk_getSaveFile -title $::title -initialfile $::dateien($pw)]
    if {$filename ne {}} {
        set ::dateien($pw) $filename
        .nb tab $pw -text [file tail $filename]
        menu_save $pw
    }
    return
}

proc menu_exit {} {
    foreach pw [.nb tabs] {
        menu_close $pw
    }
    exit
}

proc menu_undo {} {
    set pw [.nb select]
    if {$pw ne {}} {
        $pw.f1.t edit undo
    }
    return
}

proc menu_redo {} {
    set pw [.nb select]
    if {$pw ne {}} {
        $pw.f1.t edit redo
    }
    return
}

proc menu_cut {} {
    set pw [.nb select]
    if {$pw ne {}} {
        tk_textCut $pw.f1.t
    }
    return
}

proc menu_copy {} {
    set pw [.nb select]
    if {$pw ne {}} {
        tk_textCopy $pw.f1.t
    }
    return
}

proc menu_paste {} {
    set pw [.nb select]
    if {$pw ne {}} {
         tk_textPaste $pw.f1.t
    }
    return
}

proc menu_delete {} {
    set pw [.nb select]
    if {$pw ne {}} {
        #$pw.f1.t edit redo
    }
    return
}

proc menu_about {} {
    tk_messageBox -title "About $::title" -type ok -icon info \
        -message "A small editor with tabs. \nUses ttk::notebook from Tcl/Tk 8.5."
    return
}

#-----#
# GUI #
#-----#

proc gui {} {
    # Menu
    menu .menu -tearoff 0
    .menu add cascade -label File -menu .menu.file
    .menu add cascade -label Edit -menu .menu.edit
    .menu add cascade -label Help -menu .menu.help

    menu .menu.file -tearoff 0
    .menu.file add command -label New          -command menu_new    -accelerator Ctrl+N
    .menu.file add command -label Open         -command menu_open   -accelerator Ctrl+O
    .menu.file add command -label Close        -command menu_close  -accelerator Ctrl+C
    .menu.file add command -label Save         -command menu_save   -accelerator Ctrl+S
    .menu.file add command -label {Save as...} -command menu_saveAs
    .menu.file add separator
    .menu.file add command -label Exit         -command menu_exit

    menu .menu.edit -tearoff 0
    .menu.edit add command -label Undo -command menu_undo -accelerator Ctrl+Z
    .menu.edit add command -label Redo -command menu_redo -accelerator Ctrl+R
    .menu.edit add separator
    .menu.edit add command -label Cut    -command menu_cut    -accelerator Ctrl+X
    .menu.edit add command -label Copy   -command menu_copy   -accelerator Ctrl+C
    .menu.edit add command -label Paste  -command menu_paste  -accelerator Ctrl+V
    .menu.edit add command -label Delete -command menu_delete -accelerator Del

    menu .menu.help -tearoff 0
    .menu.help add command -label About -command menu_about -accelerator F1

    . configure -menu .menu

    # GUI
    ttk::notebook    .nb
    pack .nb -expand 1 -fill both

    wm geometry . 400x400
    wm protocol . WM_DELETE_WINDOW menu_exit
    return
}

#------#
# Main #
#------#
proc main {} {
    gui
    return
}
main