#!/usr/bin/env wish

package require Tcl 8.5
package require Tk 8.5
package require Ttk

set SEP tab
set DLG() ""

proc FieldList {} {list space " " tab \t , , \; \; | | - -}

proc FieldSep {} {dict get [FieldList] $::SEP}

proc SplitFilter {txt split} {lfilter [split $txt $split] ""}

proc Dialog {cmd args} {
        global DLG
        foreach {name title def} $args {
                set fr .dlg.$name
                pack [frame $fr]
                set DLG($name) $def
                pack [label $fr.lbl -text $title] [entry $fr.in -textvariable ::DLG($name)] -side left
        }
        pack [button .dlg.ok -text OK -command [list Confirm $cmd]] [button .dlg.cancel -text Cancel -command Confirm] 
}

proc Confirm {{cmd ""}} {
        destroy .dlg
        pack [frame .dlg]
        eval $cmd
        array unset ::DLG *
}

proc Cons {} {
    option add *frame.background #EEEEEE
        pack [text .txt -width 80 -height 15 -background #FFFFFF]
        pack [frame .bt]
        pack [frame .dlg]
        button .clr -text Clear -command Clear
        button .str -text Quote -command Stringify
        button .keep -text Keep -command {Dialog Keep fst "Keep first elements" 1 last "Keep last elements" 0}
        button .trim -text Trim -command {Dialog Trim trim "Chars to trim" <>}
        button .join -text "Join lines" -command {Dialog Joinlines}
        button .joinfield -text "Join fields" -command {Dialog Joinfields fst "First element" 0 snd "Last element" 1 join "Join with" ""} 
        label .lbl -text "Separator:"
        ttk::combobox .sep -values [dict keys [FieldList]] -textvariable ::SEP -width 8
        pack .clr .str .keep .trim .lbl .sep .join .joinfield -in .bt -side left
}

proc Joinlines {} {
        PutLines [list [Join [Textlines]]]
}

# stringify a string
proc Stringify-elt elt {
        if {[llength [split $elt]]==1} {return $elt}
        return \"[string map {\" '} $elt]\" ;# " keep emacs Happy
}

# stringify a line
proc Stringify-line line {
        Join [Lmap [Split $line] Stringify-elt]
}

# stringify everything
# to use data as CSV for export to a spreadsheet like MS Excel
proc Stringify {} {
        PutLines [Lmap [Textlines] Stringify-line]
}

proc Joinfields {} {
        global DLG
        set first $DLG(fst)
        set second $DLG(snd)
        set res ""
        foreach line [Textlines] {
                set linelst [Split $line]
                lappend res [Join [lreplace $linelst $first $second [JoinSpace [lrange $linelst $first $second] $DLG(join)]]]
        }
        PutLines $res
}

proc JoinSpace {lst j} {
        if {$j eq ""} {join $lst} else {join $lst $j}
}

proc Keep {} {
        global DLG
        set first $DLG(fst)
        set last $DLG(last)
        set res ""
        foreach line [Lmap [Textlines] Split] {
                lappend res [Join [concat [First $line $first] [Last $line $last]]]
        }
        PutLines $res
}

proc Split {line} {split $line [FieldSep]}
proc Join lst {join $lst [FieldSep]}

proc Trim {} {
        global DLG
        set res ""
        foreach line [Textlines] {
                lappend res [Join [Lmap [Split $line] [list TrimWord $DLG(trim)]]]
        }
        PutLines $res
}


proc TrimWord {sep word} {string trim $word $sep}

proc Lmap {lst cmd} {
        set res ""
        foreach elt $lst {
                lappend res [{*}$cmd $elt]
        }
        set res
}

proc First {lst n} {
        if {[llength $lst]<$n} {
                return $lst
        }
        lrange $lst 0 [incr n -1]
}

proc Last {lst n} {
        if {[llength $lst]<$n} {
                return $lst
        }
        lrange $lst end-[incr n -1] end
}

proc Textlines {} {
        SplitFilter [Gettext] \n
}

proc PutLines {lst} {
    set txt [join $lst \n]
        .txt delete 1.0 end; .txt delete end
        .txt insert 1.0 $txt
}
        
        
proc Clear {} {
        .txt delete 1.0 end; .txt delete end
}


proc Gettext {} {
        set t [.txt get 1.0 end]
        append t [.txt get end]
}

proc lfilter {list tofilter} {
        set res ""
        foreach l $list {if {$l ne $tofilter} {lappend res $l}}
        set res
}

        
        


Cons
wm title . "Textjam v0.3"