interfaces/xmaxima/Tkmaxima/RunMaxima.tcl

   1 ############################################################
   2 # RunMaxima.tcl                                            #
   3 # Copyright (C) 1998 William F. Schelter                   #
   4 # For distribution under GNU public License.  See COPYING. #
   5 #                                                          #
   6 #     Modified by Jaime E. Villate                         #
   7 #     Time-stamp: "2024-04-11 16:34:14 villate"            #
   8 ############################################################
   9 proc textWindowWidth { w } {
  10     set font [$w cget -font]
  11     set w20 [font measure [$w cget -font] -displayof $w "01234567890123456789"]
  12     return [expr round(floor([winfo width $w]*20.0/$w20))]
  13 }
  14
  15 proc textWindowHeight { w } {
  16     set font [$w cget -font]
  17     set h1 [font metrics [$w cget -font] -displayof $w -linespace]
  18     return [expr round([winfo height $w]/$h1)]
  19 }
  20
  21 proc resizeMaxima { win width height } {
  22     linkLocal $win pid
  23     if { [info exists pid] && $pid != "none" } {
  24         set wid [expr [textWindowWidth $win]-6]
  25         sendMaxima $win ":lisp-quiet (setq \$linel $wid)\n"
  26     }
  27 }
  28
  29 # proc packBoth {fr browser} {
  30 #     pack forget $fr $browser
  31 #     pack $fr -expand 1 -fill both -side top
  32 #     pack $browser -side bottom -expand 1 -fill both
  33 # }
  34
  35 proc CMeval { w } {
  36     linkLocal $w inputs
  37     oset $w output 0
  38     set prev ""
  39     #puts "CMeval $w, [$w compare insert < lastStart]"
  40     if { [$w compare insert < lastStart] } {
  41         set this [thisRange $w input insert]
  42         if { [llength $this] > 1 } {
  43             set code [$w get [lindex $this 0]+1c [lindex $this 1]]
  44             set code [string trimright $code \n]
  45             set prev [string trimright [$w get lastStart end] \n]
  46             $w delete lastStart end
  47             $w insert lastStart $code input
  48         }
  49     }
  50     # puts "expr=<[$w get lastStart end]>"
  51     # puts "tags=[$w tag names insert],insert=[$w index insert]"
  52     # if { [lsearch [$w tag names insert] insert] >= 0 } {
  53     #    $w mark set lastStart [lindex [$w tag prevrange input insert] 0]
  54     # }
  55     set expr [string trimright [$w get lastStart end] \n]
  56     # puts "command-line: ([$w index lastStart], [$w index end])"
  57     # puts "command: $expr"
  58     if { ![regexp {^[ \n\t]*:|[;\$][ \t]*$|^\?[\?!]?[ \t]+[^ \t]} $expr] } {
  59         $w insert insert "\n"
  60         $w see insert
  61         if { [catch {set atprompt [oget $w atMaximaPrompt]}] } {
  62             puts {atMaximaPrompt not defined}
  63         } elseif { $atprompt } {
  64             # puts "atMaximaPrompt=$atprompt"
  65             return
  66         }
  67     }
  68
  69     $w tag add input lastStart-1c "end -1char"
  70     $w tag add mprompt "lastStart linestart" lastStart
  71     $w mark set  lastStart "end -1char"
  72     lappend inputs $expr
  73
  74     oset $w inputIndex [expr {[llength $inputs] - 1}]
  75     openMathAnyKey $w [string index $expr end] [string index $expr end]
  76
  77     set tag ""
  78     # puts "sending <$expr>"
  79     # set res [sendMaxima $w $expr ]
  80     set res [sendMaxima $w $expr\n ]
  81     # set res [sendMaxima $w $expr ]
  82     # puts "[$w dump -all "lastStart linestart" end]"
  83     #message "send form"
  84 }
  85
  86 proc acceptMaxima { win port filter } {
  87     set count 3
  88     catch { close [oget $win server] }
  89     while {[incr count -1 ] > 0 } {
  90         if { ![catch {oset $win server [socket -server "runMaxima $win $filter" $port]} ] } {
  91             # puts "server sock [oget $win server]"
  92             return $port
  93         } else {
  94             incr port
  95         }
  96     }
  97     return -1
  98 }
  99
 100 proc openMaxima { win filter } {
 101     global maxima_priv env maxima_default
 102
 103     if {$maxima_priv(localMaximaServer) == ""} {
 104         return -code error [mc "Could not start Maxima - empty command"]
 105     }
 106
 107     set port $maxima_default(iLocalPort)
 108     set port [acceptMaxima $win $port $filter]
 109     if { $port >= 0 } {
 110         set com ""
 111         set command [list eval exec]
 112         # This may be needed under CYGWIN
 113         # if {$maxima_priv(platform) == "cygwin"} {lappend command "/bin/bash"}
 114
 115         append com    $maxima_priv(localMaximaServer)
 116         regsub PORT $com $port com
 117         if { [info exists env(MAXIMA_INT_INPUT_STRING)] } {
 118             regsub PORT $env(MAXIMA_INT_INPUT_STRING) $port env(MAXIMA_INT_INPUT_STRING)
 119             #puts env(MAXIMA_INT_LISP_PRELOAD)=$env(MAXIMA_INT_LISP_PRELOAD)
 120             #puts env(MAXIMA_INT_INPUT_STRING)=$env(MAXIMA_INT_INPUT_STRING)
 121         }
 122         #puts com=$com
 123         set command [concat $command  $com]
 124         if { [catch $command err ] } {
 125             #mike Must return an error to stop runOneMaxima from continuing
 126             return -code error [concat [mc "Can't execute"] "$com\n$err"]
 127         }
 128     } else {
 129         return -code error [mc "Could not open a socket "]
 130     }
 131 }
 132
 133
 134 proc runMaxima { win  filter sock args } {
 135     linkLocal $win server
 136     oset $win maximaSocket $sock
 137     fconfigure $sock -blocking 0 -translation lf
 138
 139     # Starting from 5.47post, Maxima now outputs UTF-8
 140     fconfigure $sock -encoding utf-8
 141
 142     fileevent $sock readable "$filter $win $sock"
 143
 144     if { [info exists server] } {
 145         # puts "closing server $server"
 146         catch {
 147             close $server
 148             unset server
 149         }
 150     } else {
 151         # puts "server unset ??"
 152     }
 153 }
 154
 155 proc closeMaxima { win } {
 156     global pdata
 157     linkLocal $win maximaSocket pid
 158
 159     # first close the open Maxima session
 160     catch { sendMaxima $win "quit();" }
 161
 162     # and then close the socket
 163     if {[info exists maximaSocket]} {
 164         if {$maximaSocket != ""} {
 165             set err ""
 166             catch {
 167                 close $maximaSocket
 168             } err
 169             maxStatus [concat [mc "Closed socket"] "$maximaSocket: $err"]
 170             unset maximaSocket
 171             after 500
 172             # Maxima takes time to shutdown?
 173         }
 174     } else {
 175         # tk_messageBox -icon error -message "no socket $win"
 176     }
 177
 178     if {[info exists pid]} {
 179         if {$pid != "" && [string is int $pid]} {
 180             set err ""
 181             catch {
 182                 CMkill -TERM $pid
 183             } err
 184             maxStatus [concat [mc "Killed process"] "'$pid': $err"]
 185             unset pid
 186             # Maxima takes time to shutdown?
 187             after 500
 188         }
 189     } else {
 190         # tk_messageBox -icon error -message "no pid $win"
 191     }
 192
 193     if {[info exists pdata]} {
 194         foreach v [array names pdata maxima*] { unset pdata($v) }
 195     }
 196
 197 }
 198
 199
 200 #
 201 #-----------------------------------------------------------------
 202 #
 203 # maximaFilter --  filter the output on SOCKET inserting in WINDOW
 204 # recognizing
 205 #     \032\032:file:line:charpos\n
 206 #               -->redisplay in other window
 207 # \032\031tcl: command \n
 208 #           --> eval tcl command o
 209 #
 210 #
 211 #  Results: none
 212 #
 213 #  Side Effects:  input is read from SOCK and WIN has items displayed.
 214 #
 215 #----------------------------------------------------------------
 216 #
 217 #todo fix sendMaximaWait win expr
 218 proc maximaFilter { win sock } {
 219     linkLocal $win plotPending output
 220     if {![info exists output]} {set output 1}
 221     global pdata
 222     if { [eof $sock] } {
 223         # puts "at end"
 224         close $sock
 225         return ""
 226     }
 227     set it [read $sock]
 228     # puts "read=<$it>"
 229     if { [string first "\032\032" $it] >= 0 &&
 230          [regexp  -indices "\032\032(\[^:]+):(\[0-9]+):\[^\n]*\n" $it junk file line] } {
 231
 232         dblDisplayFrame [getMatch $it $file] [getMatch $it $line]
 233         append res [string range $it 0 [expr { [lindex $junk 0] -1 } ]]
 234         append res [string range $it [expr { 1+[lindex $junk 1]}] end]
 235         set it $res
 236     }
 237     if { [string first "\032\031tcl:" $it] >= 0 && \
 238              [regexp  -indices "\032\031tcl:(\\[^\n]*)\n" $it junk com]} {
 239         eval $com
 240         append res [string range $it 0 [expr { [lindex $junk 0] -1 } ]]
 241         append res [string range $it [expr { 1+[lindex $junk 1]}] end]
 242         set it $res
 243     }
 244     # puts "it=<$it>"
 245     if { [regexp -indices "\{(plotdf|plot2d|plot3d|scene)" $it inds] } {
 246         set plotPending [string range $it [lindex $inds 0] end]
 247         set it ""
 248         if { [regexp {\(\(C|%i\)[0-9]+\) $} $it ff] } {
 249             regexp "\{(plotdf|plot2d|plot3d|scene).*\}" $ff it
 250             #   set it $ff
 251         }
 252     }
 253     if { [info exists plotPending] } {
 254         # puts "plotPending=<$plotPending>,it=<$it>"
 255         append plotPending $it
 256         set it ""
 257         if { [regexp -indices "\n\\((C|%i)\[0-9\]+\\)" $plotPending  inds] } {
 258             set it [string range $plotPending [lindex $inds 0] end]
 259             set plotPending [string range $plotPending 0 [lindex $inds 0]]
 260             set data $plotPending
 261             unset plotPending
 262             # puts "itplot=<$it>,$inds"
 263             # puts "plotdata=<$data>"
 264             doShowPlot $win $data
 265
 266         }
 267     }
 268
 269     if {[string length $it] > 0} {
 270         # Make sure Maxima's output starts on a new line but do not tag the
 271         # new line as output
 272         set it2 $it
 273         if {$output == 0} {
 274             if {[string equal -length 1 $it "\n"]} {
 275                 set it2 [string range $it 1 end]
 276             }
 277             $win insert end "\n" input
 278             set output 1
 279         }
 280         $win insert end $it2 output
 281         $win mark set lastStart "end -1char"
 282     }
 283     if { [regexp {\((?:C|%i)[0-9]+\) $|\(dbm:[0-9]+\) $|(MAXIMA>? ?)$|(none'?:? ?)$} $it junk lisp describe]  } {
 284         # puts "junk=$junk, lisp=$lisp,[expr {0 == [string compare $lisp {}]}]"
 285         # puts "it=<$it>,pdata={[array get pdata *]},[$win index end],[$win index insert]"
 286
 287         if { [info exists pdata($sock,wait) ] && $pdata($sock,wait) > 0 } {
 288             # puts "it=<$it>,begin=$pdata($sock,begin),end=[$win index {end linestart}]"
 289             # puts dump=[$win dump -all "insert -3 lines" end]
 290             setAct pdata($sock,result) [$win get $pdata($sock,begin) "end -1char linestart" ]
 291             # puts result=$pdata($sock,result)
 292             set pdata($sock,wait) 0
 293         }
 294         $win mark set lastStart "end -1char"
 295         $win tag add  input "end -1char" end
 296         oset $win atMaximaPrompt [expr { 0 == [string compare $lisp {}] && 0 == [string compare $describe {} ] } ]
 297
 298     }
 299     $win see end
 300     #moves the cursor to the end
 301     $win mark set insert output.last
 302     return
 303 }
 304
 305 proc littleFilter {win sock } {
 306     global pdata
 307     set tem [gets $sock]
 308     append pdata(maximaInit,$sock) $tem
 309     debugsend "littlefilter got:<$tem>"
 310     if { [regexp {pid=([---0-9]+)} $tem junk pid] } {
 311         fileevent $sock readable ""
 312         oset $win pid $pid
 313         oset $win socket $sock
 314     }
 315 }
 316
 317 if { ![info exists maxima_priv(timeout)] } {
 318
 319     set maxima_priv(timeout) 60000
 320 }
 321
 322 proc runOneMaxima { win } {
 323     global maxima_priv
 324     global pdata
 325
 326     closeMaxima $win
 327     linkLocal $win pid
 328     set pid "none"
 329
 330     openMaxima $win littleFilter
 331
 332     while { $pid == "none" } {
 333         set af [after $maxima_priv(timeout) oset $win pid "none" ]
 334         # puts "waiting pid=$pid"
 335         maxStatus [mc "Starting Maxima"]
 336         vwait [oloc $win pid]
 337         after cancel $af
 338         if { $pid  == "none" } {
 339             if {[tk_messageBox -type yesno -title "Connection" -icon question \
 340                      -message [mc "Starting maxima timed out. Wait longer?"]]} {
 341                 continue
 342             } else {
 343                 catch {closeMaxima $win}
 344                 set err [mc "Starting Maxima timed out"]
 345                 if {![catch {oget $win socket} sock] && \
 346                         [info exists pdata(maximaInit,$sock)] } {
 347                     append err : $pdata(maximaInit,$sock)
 348                 }
 349                 return -code error $err
 350             }
 351         }
 352     }
 353
 354     if {[catch {oget $win socket} sock]} {
 355         return -code error [mc "Failed to start Maxima"]
 356     }
 357     maxStatus [mc "Started Maxima"]
 358
 359     SetPlotFormat $maxima_priv(cConsoleText)
 360
 361     set res [list [oget $win pid] $sock ]
 362     global pdata
 363     set pdata(maxima,socket) $sock
 364     fileevent $sock readable  [list maximaFilter $win $sock]
 365     sendMaxima $win ":lisp-quiet (setq \$maxima_frontend \"Xmaxima\")\n"
 366     sendMaxima $win ":lisp-quiet (setq \$maxima_frontend_version *autoconf-version*)\n"
 367     sendMaxima $win ":lisp-quiet (setq \$maxima_frontend_bugreportinfo \"XMaxima is part of maxima.\")\n"
 368     return $res
 369
 370 }
 371
 372 proc sendMaxima { win form } {
 373     linkLocal $win maximaSocket
 374     if {![info exists maximaSocket] || $maximaSocket == ""} {return}
 375
 376     if { ![regexp "\[\$;\]\[ \t\n\r\]*\$" $form ] } {
 377         # append form ";"
 378     }
 379     if {[catch {
 380         puts -nonewline $maximaSocket $form
 381         flush $maximaSocket} err]} {
 382         set mess [mc "Error sending to Maxima:"]
 383         if {[string match "can not find channel named*" err]} {
 384             # The maxima went away
 385             set maximaSocket ""
 386             unset maximaSocket
 387             set mess [concat "$mess\n%s\n" [mc "You must Restart"] $err]
 388         } else {
 389             set mess [concat "$mess:\n%s\n" [mc "You may need to Restart"] $err]
 390         }
 391         tk_messageBox -title Error -icon error -message $mess
 392     }
 393 }
 394
 395
 396 proc sendMaximaWait { win form {timeout 20000 }} {
 397     linkLocal $win maximaWait
 398
 399     set form [string trimright $form "\n \t\r"]
 400
 401     if { ![regexp "\[\$;\]|^\[ \t]*:" $form ] } {
 402         append form ";"
 403     }
 404     sendMaximaCall $win "$form\n" [list oset $win maximaWait 1]
 405     #mike FIXME: This should be a counter
 406     set maximaWait -1
 407     set af [after $timeout oset $win maximaWait -1]
 408     vwait [oloc $win maximaWait]
 409     after cancel $af
 410
 411     set sock [oget $win maximaSocket]
 412     if {$sock == ""} {
 413         error [concat "sendMaximaWait $form" [mc "socket closed"]]
 414     }
 415     if { $maximaWait > 0 } {
 416         global pdata
 417         return [trim_maxima $pdata(${sock},result)]
 418     } else {
 419         error [concat "sendMaximaWait $form" [mc "timed out"]]
 420     }
 421 }
 422
 423
 424
 425 #
 426 #-----------------------------------------------------------------
 427 #
 428 # sendMaximaCall --  send FORM to maxima process in WIN
 429 # and when it gets the result have it execute CALL
 430 #
 431 #  Results: none
 432 #
 433 #  Side Effects: maxima executes form and then call may
 434 #  do something like insert it somewhere in a buffer.
 435 #
 436 #  # todo: should probably make it so this guy looks at maxima c, d numbers
 437 #    and matches results ..
 438 #----------------------------------------------------------------
 439 #
 440 proc sendMaximaCall { win form call } {
 441     linkLocal $win maximaSocket
 442     if {![info exists maximaSocket] || $maximaSocket == ""} {return}
 443
 444     global pdata
 445     set begin [$win index lastStart]
 446     if { [regexp {(C|%i)([0-9]+)} [$win get "$begin linestart" $begin] junk \
 447               counter ] } {
 448         #       set af [after 5000 set pdata($maximaSocket,wait) -1]
 449         set pdata($maximaSocket,wait) 1
 450
 451         set pdata($maximaSocket,begin) $begin
 452     } else {
 453         catch { unset pdata($maximaSocket,wait) }
 454     }
 455     if {[catch {
 456         puts -nonewline $maximaSocket $form
 457         flush $maximaSocket} err]} {
 458         set mess [mc "Error sending to Maxima:"]
 459         if {[string match "can not find channel named*" err]} {
 460             # The maxima went away
 461             set maximaSocket ""
 462             unset maximaSocket
 463             set mess [concat "$mess\n%s\n" [mc "You must Restart"] $err]
 464         } else {
 465             set mess [concat "$mess:\n%s\n" [mc "You may need to Restart"] $err]
 466         }
 467         tk_messageBox -title Error -icon error -message $mess
 468         return
 469     }
 470     if { [info exists counter] } {
 471         setAction pdata($maximaSocket,result) $call
 472     }
 473 }
 474
 475 proc setAction { var action } {
 476     global _actions
 477     set _actions($var) $action
 478 }
 479
 480 proc setAct { var val } {
 481     global _actions
 482     uplevel "#0" set $var [list $val]
 483     if { [info exists _actions($var)] } {
 484         uplevel "#0" $_actions($var)
 485         unset _actions($var)
 486     }
 487 }
 488
 489 proc CMresetFilter { win } {
 490     set sock [oget $win maximaSocket]
 491     fileevent $sock readable "maximaFilter $win $sock"
 492 }
 493
 494 proc CMkill {  signal pid } {
 495     global maxima_priv tcl_platform
 496
 497     # Windows pids can be negative
 498     if {[string is int $pid]} {
 499         maxStatus [mc "Sending signal %s to process %s" "$signal" "$pid"]
 500         if {$tcl_platform(platform) == "windows" } {
 501             exec $maxima_priv(kill) $signal $pid
 502         } else {
 503             exec $maxima_priv(kill) $signal $pid
 504         }
 505     }
 506 }
 507
 508 proc CMinterrupt { win } {
 509
 510     set pid [oget $win pid]
 511     if {$pid != "" && $pid != "none"} {
 512         CMkill   -INT $pid
 513     }
 514     CMresetFilter $win
 515 }
 516
 517 proc doShowPlot { w data } {
 518     global maxima_default
 519
 520     #puts data=$data
 521     set command [lindex [lindex $data 0] 0]
 522     set name [plotWindowName $w $command]
 523     if { "$command" == "plotdf" || $command == "scene" } {
 524         set command [lindex $data 0]
 525     } else {
 526         lappend command -data [lindex $data 0]
 527     }
 528     lappend command -windowname $name
 529     #   puts $command
 530     eval $command
 531     #   return
 532     set e [$w index end]
 533     if { [catch {set view [ShowPlotWindow $w $name  "$e $e" "$e $e"  ""] }]} {
 534     return }
 535     if { "$view" == "" } { return }
 536     append view " -1 line"
 537     set tem [$w dump -window $view end]
 538     global billy
 539     set billy $tem
 540     if { [llength $tem] == 3 } {
 541         after 80 $w see [lindex $tem 2]
 542         #after 400 $w see [lindex $tem 2]
 543         #puts "     after 400 $w see [lindex $tem 2]"
 544     }
 545 }
 546
 547
 548 proc dblDisplayFrame { location line } {
 549     OpenMathOpenUrl $location
 550     set panel [omPanel .]
 551     set w [oget $panel textwin]
 552     $w tag remove currentLine 0.0 end
 553     $w tag add currentLine "$line.0" "$line.0 lineend"
 554     $w tag config currentLine -foreground red
 555     set beg [lindex [split [$w index "@0,0"] .] 0]
 556     set end [lindex [split [$w index "@0,3000"] .] 0]
 557     # puts "line=$line,beg=$beg,end=$end"
 558     if { "$beg" != "" &&  ( $line < $beg + 3 || $line > $end - 3) } {
 559         $w yview [expr $line - 3]
 560     }
 561     $w see $line.0
 562 }
 563
 564
 565
 566 #
 567 #-----------------------------------------------------------------
 568 # required:
 569 #
 570 # trim_maxima --  takes STRING and trims off the prompt
 571 # and trailing space if desired.   Usually single line results
 572 # have their white space completely trimmed, while multiline
 573 # results will be left so that they display properly from left margin
 574 #
 575 #  Results:  a string with white space trimmed off
 576 #
 577 #  Side Effects:
 578 #
 579 #----------------------------------------------------------------
 580 #
 581 proc trim_maxima { string } {
 582     debugsend "in trim_maxima input=<$string>"
 583     if { [string first \n $string] == 0 } {
 584         set string [string range $string 1 end]
 585     }
 586     if { [regexp -indices "(^|\n)(\\((D|%o)\[0-9\]+\\))" $string all junk inds] } {
 587         set len [expr {[lindex $inds 1]  - [lindex $inds 0] }]
 588         set repl [genword " " $len]
 589         set ans [string range $string 0 [expr {[lindex $inds 0 ] -1}]]
 590         append ans $repl
 591         append ans [string range $string  [expr {[lindex $inds 1 ] +1}] end ]
 592         debugsend "in trim_maxima ans=<$ans>"
 593         set string [trimSpace $ans]
 594
 595     }
 596     return $string
 597 }
 598
 599 proc dshow { args  } {
 600     foreach v $args { append ans $v=[uplevel 1 set $v], }
 601     puts $ans
 602 }
 603 proc maxima_insert { w this next val args } {
 604     catch {
 605         set res [uplevel "#0" set $val]
 606     }
 607     catch {
 608         insertResult_maxima $w $this $next [trim_maxima $res]
 609     }
 610 }
 611
 612 proc eval_maxima { prog win this nextResult } {
 613     global maxima_priv
 614     set w $maxima_priv(maximaWindow)
 615     linkLocal $w maximaSocket
 616     if {![info exists maximaSocket] || $maximaSocket == ""} {return}
 617
 618     set form [string trimright [eval $win get $this] " \t\n;$"]
 619     set form [addPreloads $form maxima $win $this]
 620     if { "[lindex $nextResult 0]" != "" } {
 621         sendMaximaCall $w "$form;\n" [list maxima_insert $win $this  $nextResult pdata($maximaSocket,result)]
 622
 623         #         set res [sendMaximaWait $maxima_priv(maximaWindow) "$form;"]
 624         #       insertResult_maxima $win $this  $nextResult $res
 625     } else {
 626         sendMaxima $maxima_priv(maximaWindow) "$form;\n"
 627     }
 628     return 0
 629 }
 630
 631
 632
 633
 634
 635 proc changeSize { win  y } {
 636     set del 0
 637     set tem [expr { [winfo rooty $win] + [winfo height $win] } ]
 638     set del [expr {abs($y-$tem) <20 ? 0: $y-$tem < 0 ? -1 : 1 }]
 639     if { $del } {
 640         set h [$win cget -height]
 641         incr h $del
 642         if { $h >= 1 } {
 643             $win config -height $h
 644         }
 645     }
 646
 647 }