MimeTexBuffer
FF 2007-05-19 - MimeTexBuffer aims to be an interactive math formula edit buffer. See it in action:
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
#!/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
}
}