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 12proc 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 43proc CNinterrupt { w } { 44 sendInterrupt [oget $w program] 45} 46 47proc CNclearinput { w } { 48 if { [$w compare lastStart < insert] } { 49 pushl "[saveText $w lastStart insert ]" killRing 50 $w delete lastStart insert 51 } 52} 53 54 55proc 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 67proc 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 114proc 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 143proc 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# 171proc 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 196