interfaces/xmaxima/Tkmaxima/NConsole.tcl

   1 # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
   2 #
   3 #       $Id: NConsole.tcl,v 1.10 2006-12-04 10:45:46 villate Exp $
   4 #
   5 ###### NConsole.tcl ######
   6 ############################################################
   7 # Netmath       Copyright (C) 1998 William F. Schelter     #
   8 # For distribution under GNU public License.  See COPYING. #
   9 ############################################################
  10
  11
  12 proc mkConsole { fr program } {
  13     catch { destroy $fr }
  14     global NCtextHelp
  15     frame $fr
  16     pack $fr -expand 1 -fill both
  17     set w $fr.text
  18     label [set msg $fr.label]  -height 1 -relief sunken \
  19             -textvariable maxima_priv(load_rate)
  20
  21     oset $w program $program
  22     oset $w prompt "% "
  23     text $w
  24     bind $w <Configure> "resizeSubPlotWindows $w %w %h"
  25
  26     $w tag configure input -foreground blue
  27     # -relief sunken -borderwidth 1
  28     bindtags $w [linsert [bindtags $w] 1 CNtext OpenMathText ]
  29
  30     global maxima_priv
  31
  32     if { ![regexp -- $maxima_priv(sticky) input] } {
  33         append maxima_priv(sticky) {|^input$}
  34     }
  35
  36     CNinsertPrompt $w
  37     $w mark gravity lastStart left
  38     pack $w -side top -expand 1 -fill both
  39     pack $msg -side bottom -expand 0 -fill x
  40     raise $w
  41 }
  42
  43 proc CNinterrupt { w } {
  44     sendInterrupt [oget $w program]
  45 }
  46
  47 proc CNclearinput { w } {
  48     if { [$w compare lastStart < insert] } {
  49         pushl "[saveText $w lastStart insert ]" killRing
  50         $w delete lastStart insert
  51     }
  52 }
  53
  54
  55 proc CNinsertPrompt { w } {
  56     set prompt [oget $w prompt]
  57     $w mark set insert end
  58     if { [$w compare insert > "insert linestart"] } {
  59         $w insert insert \n
  60     }
  61     $w insert insert "$prompt" prompt
  62     $w mark set lastStart [$w index "end -1char"]
  63     $w see end
  64     #puts [$w dump -all "[$w index end] -2 lines" end]
  65 }
  66
  67 proc CNeval { w } {
  68     linkLocal $w inputs inputIndex
  69     set prev ""
  70     if { [$w compare insert < lastStart] } {
  71         set this [thisRange $w input insert]
  72         if { "$this" != "" } {
  73             set code [eval $w get $this]
  74             set prev [string trimright [$w get lastStart end] \n]
  75
  76             $w delete lastStart end
  77             $w insert lastStart $code input
  78         }
  79     }
  80     set expr [string trimright [$w get lastStart end] \n]
  81     $w tag add input lastStart end
  82     lappend inputs $expr
  83     set inputIndex [expr {[llength $inputs] - 1}]
  84     set tag ""
  85     #puts "sendind <$expr>"
  86     set res [sendOneWait [oget $w program] $expr]
  87     message "received result"
  88
  89     if { "$res" != "" } {
  90         if { ![regexp \n $res] } {
  91             set tag center
  92             set res "\n $res"
  93         }
  94
  95         if { [regexp "\{plot\[23\]d" $res] } {
  96             linkLocal $w counter
  97             #puts res=$res
  98             if { ![info exists counter] } {set counter 0}
  99             set name $w.plot[oset $w counter [expr {1 + [oget $w counter]}]]
 100             eval plot2dData $name $res [getDimensions $w $name]
 101             set e [$w index end]
 102             set view [ShowPlotWindow $w $name  "$e $e" "$e $e"  ""]
 103             append view " -1 line"
 104         } else {
 105             $w insert end $res "$tag result"
 106         }
 107
 108     }
 109     CNinsertPrompt $w
 110     if { [info exists view] } {$w yview $view }
 111     if { "$prev" != "" }  {$w insert insert $prev}
 112 }
 113
 114 proc CNpreviousInput { w direction } {
 115     linkLocal $w  inputIndex matching
 116     if { [catch {makeLocal $w inputs}] } { return }
 117     if { [$w compare insert < lastStart ] } { return }
 118
 119     set last [lindex [peekLastCommand $w] 1]
 120     if {  ("[lindex $last 2]" != "ALT_p" && "[lindex $last 2]" != "ALT_n") || \
 121               ![info exists inputIndex] } {
 122         set inputIndex [expr {$direction < 0 ? [llength $inputs] : -1}]
 123         set matching [string trim [$w get lastStart end] " \n"]
 124     }
 125     if {[info exists $matching]} {
 126         lappend inputs $matching
 127     }
 128     set n [llength $inputs]
 129     set j 0
 130     set matchRegexp "[quoteForRegexp $matching]"
 131     while {[incr j] <= $n } {
 132         set inputIndex [expr {($inputIndex + $direction+ $n)%$n}]
 133         # [string match "$matching*" [lindex $inputs $inputIndex]]
 134         if { [regexp -- $matchRegexp [lindex $inputs $inputIndex]] } {
 135             $w delete lastStart end
 136             $w insert insert [lindex $inputs $inputIndex]
 137             $w see insert
 138             break
 139         }
 140     }
 141 }
 142
 143 proc CNblinkMatchingParen { win ch } {
 144     $win tag delete blink
 145     if { [string first $ch "\}\)\]"] >= 0 } {
 146         set tem [$win get "@0,0" "insert"]
 147         set ind [matchingParen $tem]
 148         if { "$ind" != "" } {
 149             set ind [expr {[string length $tem] - $ind}]
 150             catch { after cancel [oget $win blinkAfter] }
 151             set i [$win index "insert -$ind chars"]
 152             $win tag add blink "$i" "$i +1char"
 153             $win tag configure blink -foreground red
 154             oset $win blinkAfter [after 1000 $win tag delete blink]
 155         }
 156     }
 157 }
 158
 159
 160 #
 161 #-----------------------------------------------------------------
 162 #
 163 # matchingParen --  Return index of STRING which a close paren
 164 #   would match if added to end.
 165 #  Results: index
 166 #
 167 #  Side Effects: none
 168 #
 169 #----------------------------------------------------------------
 170 #
 171 proc matchingParen { s1  } {
 172     set s $s1
 173     set ind [string length $s]
 174     set count -1
 175     regsub -all "\[\01\02\]" $s x s
 176     regsub -all "\[\]\}\)\]" $s "\01c" s
 177     regsub -all "\[\[\{\(\]" $s "\01o" s
 178     set lis [split $s \01]
 179     set n [llength $lis]
 180     while { [incr n -1] > 0 } {
 181         set v [lindex $lis $n]
 182         incr ind -[string length $v]
 183         set c [string index $v 0]
 184         if { "$c" == "c" } {
 185             incr count -1
 186         } else {
 187             incr count
 188         }
 189         if { $count == 0 } {
 190             return $ind
 191         }
 192     }
 193 }
 194
 195 ## endsource nconsole.tcl