Version 23 of MimeTexBuffer

Updated 2012-05-13 04:19:18 by RLE

FF 2007-05-19 - MimeTexBuffer aims to be an interactive math formula edit buffer. See it in action:

http://wiki.tcl.tk/_repo/images/FF/MimeTexBuf2.gif

or try the code.

This is preliminary draft buggy crap junk hackish code of a project I'll work in the near future. I post the code just right now so that you can enjoy hacking it :P

I'm a bit tired and won't put my hands over it for a couple of days ^_^

See also: MimeTexPreview, TeX

http://wiki.tcl.tk/_repo/images/FF/MimeTexBuf3.gif


 #!/bin/sh
 # This line continues for Tcl, but is a single line for 'sh' \
 exec tclsh "$0" ${1+"$@"}

 package require Tk 8.4
 package require base64

 grid [canvas .c] -row 0 -columnspan 2 -sticky news
 bind . <KeyPress> {kp %W %K}

 set img ""
 set caret "@@@@8976@@@@"
 set buf $caret
 set brkt 0

 proc render e {
        global img
        .c delete eee
        catch {image delete $img}
        set p [open [list |mimetex -d "$e"] r]
        fconfigure $p -translation binary -encoding binary
        set rawData [base64::encode [read $p]]
        close $p
        set img [image create photo -data $rawData]
        .c create image 10 10 -image $img -tags eee -anchor nw
 }

 proc inputbox {w text {default {}}} {
        global frmReturn
        catch {destroy $w}
        toplevel $w -class Inputbox
        wm iconname $w Inputbox
        wm protocol $w WM_DELETE_WINDOW { }
        wm transient $w .
        pack [frame $w.bot -relief raised -bd 1] -side bottom -fill both
        pack [frame $w.top -relief raised -bd 1] -side top -fill both -expand 1
        option add *Inputbox.msg.wrapLength 3i widgetDefault
        label $w.msg -justify left -text $text -font {Times 18}
        entry $w.entry
        pack $w.msg -in $w.top -side top -expand 1 -fill both -padx 3m -pady 3m
        pack $w.entry -in $w.top -side top -expand 1 -fill x -padx 3m -pady 3m
        grid [button $w.b0 -text ok -command "set frmReturn \[$w.entry get\]"] \
                -in $w.bot -column 0 -row 0 -stick sw -padx 10
        grid [button $w.b1 -text cancel -command {set frmReturn ""}] \
                -in $w.bot -column 1 -row 0 -stick sw -padx 10
        $w.entry insert end $default
        bind $w.entry <Return> "$w.b0 invoke"
        bind $w <Destroy> {set frmReturn {}}
        wm withdraw $w
        update idletasks
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2\
                - [winfo vrootx [winfo parent $w]]]
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2\
                - [winfo vrooty [winfo parent $w]]]
        wm geometry $w +$x+$y
        wm deiconify $w
        set oldfocus [focus]
        set oldgrab [grab current $w]
        if {$oldgrab != ""} {
                set grabstatus [grab status $oldgrab]
        }
        grab $w
        focus $w.entry
        tkwait variable frmReturn
        set lr $frmReturn
        catch {focus $oldfocus}
        catch {
                bind $w Destroy {}
                destroy $w
        }
        if {$oldgrab != ""} {
                if {$grabstatus == "global"} {
                        grab -global $oldgrab
                } else {
                        grab $oldgrab
                }
        }
        return $lr
 }

 proc kp {w keysym_s} {
        global buf caret brkt
        set caretpos [lsearch $buf $caret]
        set len [llength $buf]
        set queue {}
        if [regexp {^[a-z0-9]$} $keysym_s] {
                set buf [linsert $buf $caretpos $keysym_s]
        } else { switch -- $keysym_s {
                Shift_L - Shift_R {return}
                backslash   {
                        set macro [inputbox .macroInput "Input TeX macro:" \\]
                        puts "macro=\"$macro\""
                        if {$macro != "" && $macro != "\\"} {
                                set buf [linsert $buf $caretpos " $macro "]
                        }
                }
                plus        { set buf [linsert $buf $caretpos "+"]           }
                minus       { set buf [linsert $buf $caretpos "-"]           }
                equal       { set buf [linsert $buf $caretpos "="]           }
                comma       { set buf [linsert $buf $caretpos ","]           }
                period      { set buf [linsert $buf $caretpos "."]           }
                exclam      { set buf [linsert $buf $caretpos "\\not"]       }
                asterisk    { set buf [linsert $buf $caretpos " \\cdot "]    }
                parenleft   { set buf [linsert $buf $caretpos " \\left( "]   }
                parenright  { set buf [linsert $buf $caretpos " \\right) "]  }
                asciicircum {
                        set buf [linsert $buf $caretpos "\}"]
                        set buf [linsert $buf $caretpos "^\{"]
                        lappend queue Left
                }
                underscore  {
                        set buf [linsert $buf $caretpos "\}"]
                        set buf [linsert $buf $caretpos "_\{"]
                        lappend queue Left
                }
                Escape {
                        if {$brkt > 0} {
                                incr brkt -1
                                set buf [linsert $buf $caretpos "\} "]
                        }
                }
                Return { set buf [linsert $buf $caretpos "\\\\"] }
                space { set buf [linsert $buf $caretpos "\\ "] }
                slash {
                        set buf [linsert $buf [expr $caretpos+0] " \\frac\{"]
                        set buf [linsert $buf [expr $caretpos+2] "\}\{"]
                        set buf [linsert $buf [expr $caretpos+3] "\} "]
                }
                BackSpace {
                        if {$caretpos > 0} {
                                set newbuf [list]
                                eval lappend newbuf [lrange $buf 0 [expr $caretpos-2]]
                                lappend newbuf $caret
                                eval lappend newbuf [lrange $buf [expr $caretpos+1] end]
                                set buf $newbuf
                                unset newbuf
                        }
                }
                Delete {
                        if {$len > 1 && [expr $caretpos+1] < $len} {
                                set newbuf [list]
                                eval lappend newbuf [lrange $buf 0 [expr $caretpos-2]]
                                lappend newbuf [lindex $buf [expr $caretpos-1]]
                                lappend newbuf $caret
                                eval lappend newbuf [lrange $buf [expr $caretpos+2] end]
                                set buf $newbuf
                                unset newbuf
                        }
                }
                Left {
                        if {$caretpos > 0} {
                                set newbuf [list]
                                eval lappend newbuf [lrange $buf 0 [expr $caretpos-2]]
                                lappend newbuf $caret
                                lappend newbuf [lindex $buf [expr $caretpos-1]]
                                eval lappend newbuf [lrange $buf [expr $caretpos+1] end]
                                set buf $newbuf
                                unset newbuf
                        }
                }
                Right {
                        if {[expr $caretpos+1] < $len} {
                                set newbuf [list]
                                eval lappend newbuf [lrange $buf 0 [expr $caretpos-1]]
                                lappend newbuf [lindex $buf [expr $caretpos+1]]
                                lappend newbuf $caret
                                eval lappend newbuf [lrange $buf [expr $caretpos+2] end]
                                set buf $newbuf
                                unset newbuf
                        }
                }
                default {
                        puts "unknown keysym: $keysym_s"
                }
        }}
        set len [llength $buf]
        foreach {sym symr} {sqrt "\\sqrt\{" sin "\\sin " cos "\\cos "
                        tan "\\tan " atan "\\atan " phi "\\phi " pi "\\pi "} {
                set sl [string length $sym]
                for {set i 0} {$i < [expr $len-$sl]} {incr i} {
                        set m [join [lrange $buf $i [expr $i+$sl-1]] ""]
                        if {$m == $sym} {
                                set newbuf [lrange $buf 0 [expr $i-1]]
                                lappend newbuf $symr
                                if {[lindex [split $symr ""] end] == "\{"} {
                                        lappend newbuf "\}"
                                        lappend queue Left
                                }
                                eval lappend newbuf [lrange $buf [expr $i+$sl] end]
                                set buf $newbuf
                                unset newbuf
                                break
                        }
                }
        }

        if {[llength $queue] > 0} {
                foreach q $queue {kp $w $q}
        } else {
                set buf_p [string map [list $caret " \\mid "] [join $buf ""]]
                render $buf_p
        }
 }