[FF] 2007-05-19 - MimeTexBuffer aims to be an interactive math formula edit buffer. See it in action: [http://dev.gentoo.org/~mescalinum/tclwiki-img/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://dev.gentoo.org/~mescalinum/tclwiki-img/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 . {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 "$w.b0 invoke" bind $w {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 } } ---- [[ [Category Mathematics] | [Category Graphics] ]]