6059c14e30dfe5449e1bdb0fdf6f59d1e7766268
[scilab.git] / scilab / modules / scipad / tcl / scilabexec.tcl
1 #  Scipad - programmer's editor and debugger for Scilab
2 #
3 #  Copyright (C) 2002 -      INRIA, Matthieu Philippe
4 #  Copyright (C) 2003-2006 - Weizmann Institute of Science, Enrico Segre
5 #  Copyright (C) 2004-2008 - Francois Vogel
6 #
7 #  Localization files ( in tcl/msg_files/) are copyright of the
8 #  individual authors, listed in the header of each file
9 #
10 # This program is free software; you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 2 of the License, or
13 # (at your option) any later version.
14 #
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 # GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, write to the Free Software
22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 #
24 # See the file scipad/license.txt
25 #
26 proc execfile {{buf "current"}} {
27 # return argument: 0=success, 1=scilab busy, 2=cancel overwrite, -1=fail
28     global listoffile pad
29     global tmpdir
30
31     if {$buf == "current"} {
32         set textarea [gettextareacur]
33     } else {
34         set textarea $buf
35     }
36
37     if {[$textarea index end-1c] == 1.0} {
38         showinfo [mc "No point in loading an empty file!"]
39         return 2
40     }
41
42     if {[isscilabbusy 1 $listoffile("$textarea",fullname)]} {return 1}
43
44     set savedintempdir false
45
46     if {[ismodified $textarea]} {
47         # try to save the file in a temporary directory
48         set nametosave [file join $tmpdir [file tail $listoffile("$textarea",fullname)]]
49         if {[catch {writefileondisk $textarea $nametosave 0}] != 0} {
50             set answer [tk_messageBox -title [mc "Silent file save failed"] \
51                     -icon question -type yesnocancel \
52                     -message [mc "File could not be saved in a temporary location.\nOverwrite original file?"] ]
53             switch -- $answer {
54                 yes    { filetosave $textarea; set f $listoffile("$textarea",fullname); set doexec 1 }
55                 no     { set doexec 0 }
56                 cancel { set doexec 0; return 2 }
57             }
58         } else {
59             set f $nametosave
60             set doexec 1
61             set savedintempdir true
62         }
63     } else {
64         # file is not modified wrt to its version on disk - use this version on disk
65         set f $listoffile("$textarea",fullname)
66         set doexec 1
67     }
68
69     if $doexec {
70         if {[catch {ScilabEval_lt "exec(\"$f\");" "sync" "seq"}]} {
71             scilaberror $listoffile("$textarea",fullname)
72             set outval -1
73         } else {
74             showinfo [mc "Exec done"]
75             set outval 0
76         }
77     }
78
79     if {$savedintempdir} {
80         catch {file delete -- $f}
81     }
82
83     # this is in case a script modifies a file opened in Scipad
84     checkifanythingchangedondisk $pad
85
86     return $outval
87 }
88
89 proc execselection {} {
90 # run the Scipad selection in Scilab
91 # note: block selection is supported
92     global tcl_platform pad
93
94     # execselection cannot be executed since it needs the colorization results
95     if {[colorizationinprogress]} {return}
96
97     if {[isscilabbusy 2]} {return}
98
99     set textareacur [gettextareacur]
100     set selindices [gettaselind $textareacur any]
101     if {$selindices != ""} {
102         set f [gettatextstring $textareacur $selindices]
103         #SciEval does not digest multilines, nor comments. The following hacks are
104         # not optimal - they can produce very long lines, and get confused about
105         # quoted strings containing //.
106         #strip comments from // to \n (note - \n stays, as the interpreter allows
107         #    "...//bla\n rest" ) (NOTE: this way strings like "...//..." are truncated
108         #    -- FIXIT -- has to use tag textquoted information)
109         regsub -all -line "//.*(\\n|\\Z)" $f "\n" f1
110         unset f
111         # remove trailing white space
112         regsub -all -line "^\\s*" $f1 " " f2
113         unset f1
114         #join continued lines
115         regsub -all -line "\\.{2,} *\\n" $f2 "" f3
116         unset f2
117         #join multilines with ";"
118         regsub -all -line "\\n" $f3 ";" comm
119         unset f3
120         # last hack - add a final endfunction if there is an unterminated
121         # function in the selection: TODO (try to involve proc whichfun)
122         # Things are complicated because the selection may either include
123         #  the originating "function" or not
124         set i1 [$textareacur index sel.first]
125         set i2 [$textareacur index sel.last]
126 #TODO ES 9/10/03
127 #        if { $i2>$i1 } {
128 #            set funselstart [lindex [whichfun $i1] 0]
129 #            set funselend [lindex [whichfun $i2] 0]
130 #        } else {
131 #            set funselstart [lindex [whichfun $i2] 0]
132 #            set funselend [lindex [whichfun $i1] 0]
133 #        }
134 #        tk_messageBox -message $funselstart"--"$funselend
135 #        if { $funselend !={} && $funselstart == {}} {
136 #            append comm ",endfunction"}
137 #            if { $funselend !={} && $funselstart != $funselend} {
138 #                tk_messageBox -message \
139 #                    "How do you pretend Scilab to evaluate the bottom of a function definition without its header?"
140 #                return
141 #        }
142         # Besides, I'd like to see screen output too.
143         regsub -all -line "\"" $comm "\"\"" dispcomm
144         regsub -all -line "'" $dispcomm "''" dispcomm1
145         unset dispcomm
146         # The following test is to cope with string length limits in C language using %s
147         # The hardwired limit in character length is 509-13 since (quote from the MSDN
148         # Library - Oct 2001):
149         # ANSI compatibility requires a compiler to accept up to 509 characters in a string
150         # literal after concatenation. The maximum length of a string literal allowed in
151         # Microsoft C is approximately 2,048 bytes.
152         # (end of quote)
153         # Because I don't know the limit for other compilers, I keep 509 as the maximum
154         # above which the string is not displayed. Anyway, more than this is very hard
155         # to read in the Scilab shell.
156         if {[string length $dispcomm1] < 496} {
157             ScilabEval_lt "mprintf(\"%s\\n\",\"$dispcomm1\")"
158         }
159         ScilabEval_lt $comm
160         # this is in case the evaluated script modifies a file opened in Scipad
161         checkifanythingchangedondisk $pad
162     }
163 }
164
165 proc importmatlab {} {
166     global pad listoffile
167     global tileprocalreadyrunning
168     global bug2672_shows_up Tk85
169     global preselectedfilterinimportmatlabbox
170
171     if {$tileprocalreadyrunning} {return}
172
173     if {[isscilabbusy 3]} {return}
174
175     set matfiles [mc "Matlab files"]
176     set allfiles [mc "All files"]
177     set types [concat "{\"$matfiles\"" "{*.m}}" \
178                       "{\"$allfiles\"" "{* *.*}}" ]
179     set dtitle [mc "Matlab file to convert"]
180     if {$Tk85} {
181         # make use of TIP242 (-typevariable option)
182         # note that $bug2672_shows_up is necessary false (see
183         # definition of bug2672_shows_up)
184             set sourcefile [tk_getOpenFile -filetypes $types -parent $pad -title "$dtitle" \
185                                            -typevariable preselectedfilterinimportmatlabbox]
186     } else {
187         if {$bug2672_shows_up} {
188             set sourcefile [tk_getOpenFile -filetypes $types -title "$dtitle"]
189         } else {
190             set sourcefile [tk_getOpenFile -filetypes $types -parent $pad -title "$dtitle"]
191         }
192     }
193     if {$sourcefile !=""} {
194         set sourcedir [file dirname $sourcefile]
195         set destfile [file rootname $sourcefile].sci
196         set convcomm "execstr(\"res=mfile2sci(\"\"$sourcefile\"\",\
197                       \"\"$sourcedir\"\",%f,%f,1,%t)\",\"errcatch\",\"m\")"
198         set impcomm \
199             "if $convcomm==0 then \
200                TCL_EvalStr(\"delinfo; openfile \"\"$destfile\"\"\",\"scipad\"); \
201              else; \
202                TCL_EvalStr(\"failmatlabimp\",\"scipad\");\
203              end"
204         showinfo [mc "Scilab is converting, please hold on..." ]
205         ScilabEval_lt $impcomm "sync" "seq"
206     }
207 }
208
209 proc failmatlabimp {} {
210     global ScilabBugzillaURL
211     tk_messageBox -title [mc "Matlab file import"]  \
212       -message [concat [mc "Conversion of the file failed, see the Scilab window\
213                     for details -- Perhaps report the error text and the\
214                     offending Matlab file to"] \
215                     $ScilabBugzillaURL] \
216       -icon error
217 }
218
219 proc helpskeleton {} {
220     global listoffile
221     # first exec the file in scilab, so that the current function is
222     #  really defined; then call help_skeleton, and pipe the
223     # result to a new (unsaved) buffer.
224     # NB: execing the file can have far-reaching consequences
225     #  if the file does more than just defining functions.
226     # Responsibility left to the user.
227     global tileprocalreadyrunning
228     if {$tileprocalreadyrunning} {return}
229     if {[isscilabbusy 0]} {return}
230     set indexin [[gettextareacur] index insert]
231     scan $indexin "%d.%d" ypos xpos
232     set infun [whichfun $indexin]
233     set funname [lindex $infun 0]
234     if {[execfile]==0} {
235         set pathprompt [mc "Please select destination path for the xml source of the help file" ]
236         set dir [tk_chooseDirectory -title $pathprompt]
237         if {$dir != ""} {
238             set xmlfile [file join $dir $funname.xml]
239             set warntitle [concat [mc "Older version of"] $xmlfile [mc "found!"] ]
240             set warnquest [concat [mc "An old version of"] $xmlfile [mc "already exists: open the old file instead?"] ]
241             set warnold [mc "Existing file" ]
242             set warnnew [mc "New skeleton"]
243             if [file exists $xmlfile] {
244                 set answer [tk_dialog .existxml $warntitle $warnquest \
245                       questhead 0 $warnold $warnnew]
246             } else {
247                 set answer 1
248             }
249             if $answer {
250                   ScilabEval_lt "help_skeleton(\"$funname\",\"$dir\")" "sync"
251             }
252             openfile $xmlfile
253         }
254     }
255 }
256
257 proc xmlhelpfile {} {
258 # save the file and call xmlfiletohtml. Catch and popup the error messages.
259     global listoffile
260
261     if {[isscilabbusy 4]} {return}
262
263     filetosavecur
264     set filetocomp $listoffile("[gettextareacur]",fullname)
265     set filename [file tail    $filetocomp]
266     set filepath [file dirname $filetocomp]
267     set cwd [pwd]
268     cd $filepath
269     ScilabEval_lt "xmlfiletohtml(\"$filename\")" sync
270     cd $cwd
271 }
272
273 proc ScilabEval_lt {comm {opt1 ""} {opt2 ""}} {
274 # ScilabEval with length test
275 # This is needed because ScilabEval cannot accept commands longer than bsiz
276 # (they are truncated by Scilab). Workaround: Long commands shall be saved
277 # into a file that is exec'ed by ScilabEval.
278 # This proc checks first the length of the command passed to ScilabEval.
279 # - If this length is smaller than bsiz-1, pass the command to ScilabEval for
280 # execution.
281 # - If this length is greater than bsiz-1 but smaller than lsiz-1, save the
282 # command in a file and do a ScilabEval exec("the_file"). If this fails
283 # (wrong permission rights...) then warn the user that something really weird
284 # might happen since there is no way to pass the command to Scilab.
285 # - If this length is greater than lsiz-1, warn the user that the command
286 # cannot be passed to Scilab
287
288     # this global solves bugs 1848 and 1853 even if sciprompt is not used in proc ScilabEval_lt
289     global sciprompt
290
291     global tmpdir
292     set bsiz_1  4095   ;# Must be consistent with bsiz defined in routines/stack.h
293     set lsiz_1 65535   ;# Must be consistent with lsiz defined in routines/stack.h
294     set commlength [string length $comm]
295     if {$commlength <= $bsiz_1} {
296         # No problem to process this
297         ScilabEval $comm $opt1 $opt2
298     } elseif {$commlength <= $lsiz_1} {
299         # Command is too long for a direct ScilabEval but can be passed through an exec'ed file
300         # Create a file in tmpdir, and save the command in it.
301         # Large (>$splitsize) commands are splitted into smaller parts, and trailing dots
302         # are added.
303         # This part is catched to take into account possible access (permissions) errors
304         if {[catch {
305             set fname [file join $tmpdir "ScilabEval_command.sce"]
306             set splitsize 4000 ;# arbitrary but works up to approx. 4095
307             set nbparts [expr {[string length $comm] / $splitsize + 1}]
308             set fid [open $fname w]
309             set startpos 0
310             for {set i 1} {$i < $nbparts} {incr i} {
311                 set stoppos  [expr {$i * $splitsize - 1}]
312                 # Warning: the string must not be split (.. added) just after a dot!
313                 # Here possible endless loop if $comm contains only dots, but why would this happen?
314                 while {[string index $comm $stoppos] == "."} {incr stoppos}
315                 puts $fid "[string range $comm $startpos $stoppos].."
316                 set startpos [incr stoppos]
317             }
318             puts $fid [string range $comm $stoppos end]
319             close $fid
320             ScilabEval "exec(\"$fname\");" $opt1 $opt2
321         }] != 0} {
322             tk_messageBox  -title [mc "ScilabEval command cannot be passed to Scilab!"] -icon warning -type ok \
323                            -message [concat [mc impossibleScilabEval_message] "ScilabEval" $comm $opt1 $opt2]
324         }
325     } else {
326         # Command is definitely too long to be passed to Scilab, even if exec'ed in a file
327         # If the command was nevertheless sent, it would trigger error 108
328         # Even tk_messageBox does not accept too large -message content
329         set comm [concat "[string range $comm 0 4000]..." [mc "(end of command skipped)"] ]
330         tk_messageBox  -title [mc "ScilabEval command cannot be passed to Scilab!"] -icon warning -type ok \
331                        -message [concat [mc impossibleScilabEval_message2] "ScilabEval" $comm $opt1 $opt2]
332     }
333 }
334
335 proc cleantmpScilabEvalfile {} {
336 # Try to remove the possibly existing files in tmpdir
337 # created by ScilabEval_lt
338     global tmpdir
339     catch {file delete [file join $tmpdir "ScilabEval_command.sce"]}
340 }
341
342 proc isscilabbusy {{messagenumber "nomessage"} args} {
343 # check if Scilab is busy or not
344 # return true if busy, and false if idle
345 # $messagenumber, if present, gives a message id to display in a message box
346 # additional arguments may be passed to customize the message
347 # if $messagenumber is not given, then no message will be displayed and the
348 # test on Scilab idleness is silent
349     global sciprompt
350     if {[string compare $sciprompt -1] == 0} {
351         if {$messagenumber == "nomessage"} {
352             return true
353         }
354         switch -exact -- $messagenumber {
355             0 { set mes \
356                 [mc "Scilab is working, please wait for the prompt to execute this command!"]
357               }
358             1 { set mes [concat \
359                 [mc "Scilab is working, wait for the prompt to load file"] \
360                  [lindex $args 0] ]
361               }
362             2 { set mes \
363                 [mc "Scilab is working, wait for the prompt to execute the selection."]
364               }
365             3 { set mes \
366                 [mc "Scilab is working, wait for the prompt to convert a Matlab file."]
367               }
368             4 { set mes \
369                 [mc "Scilab is working, wait for the prompt to compile the help file."]
370               }
371             5 { set mes \
372                 [mc "Scilab is working, wait for the prompt to issue a debugger command."]
373               }
374             default { set mes \
375                 "Unexpected message number in proc isscilabbusy - Please report."
376             }
377         }
378         tk_messageBox -message $mes -title [mc "Scilab working"] -type ok -icon info
379         return true
380     } else {
381         return false
382     }
383 }
384
385 proc scilaberror {funnameargs} {
386     global ScilabErrorMessageBox
387     global errnum errline errmsg errfunc
388     # Communication between Scipad and Scilab through
389     # Tcl global interp is not supported by Scilab 5
390     # See http://wiki.scilab.org/Tcl_Thread
391     ScilabEval_lt "\[db_str,db_n,db_l,db_func\]=lasterror();" "sync" "seq"
392     ScilabEval_lt  "TCL_SetVar(\"errnum\", string(db_n), \"scipad\");" "sync" "seq"
393     ScilabEval_lt  "TCL_SetVar(\"errline\", string(db_l), \"scipad\");" "sync" "seq"
394     ScilabEval_lt  "TCL_SetVar(\"errfunc\", strsubst(db_func,\"\"\"\",\"\\\"\"\"), \"scipad\")" "sync" "seq"
395     ScilabEval_lt  "TCL_SetVar(\"errmsg\" , strsubst( \
396                                             strsubst( \
397                                             strsubst( \
398                                             strsubst( \
399                                             strsubst( \
400                                                        strcat(stripblanks(db_str),ascii(13)) \
401                                                              ,\"\"\"\",\"\\\"\"\") \
402                                                              ,\"''\",\"\\''\") \
403                                                              ,\"$\",\"\\$\") \
404                                                              ,\"\[\",\"\\\[\") \
405                                                              ,\"\]\",\"\\\]\") \
406                                           , \"scipad\" )" "sync" "seq"
407     if {$ScilabErrorMessageBox} {
408         tk_messageBox -title [mc "Scilab execution error"] \
409           -message [append dummyvar [mc "The shell reported an error while trying to execute "]\
410           $funnameargs [mc ": error "] $errnum "\n" $errmsg "\n" [mc "at line "]\
411           $errline [mc " of "] $errfunc]
412     }
413     showinfo [mc "Execution aborted!"]
414     if {[getdbstate] != "NoDebug"} {
415         canceldebug_bp
416     }
417     blinkline $errline $errfunc
418 }
419
420 proc blinkline {li ma {nb 3}} {
421 # Blink $nb times logical line $li in macro function named $ma
422 # The macro is supposed to be defined in one of the opened buffers (no
423 # opening of files occur here)
424 # Warning: This proc is also used from outside of Scipad by edit_error
425     global SELCOLOR
426     set funtogoto [funnametofunnametafunstart $ma]
427     if {$funtogoto != ""} {
428         dogotoline "logical" $li "function" $funtogoto
429         set w [lindex $funtogoto 1]
430         set i1 [$w index "insert linestart"]
431         set i2 [$w index "insert lineend + 1c"]
432         for {set i 0} {$i < $nb} {incr i} {
433             $w tag add blinkedline $i1 $i2
434             $w tag configure blinkedline -background $SELCOLOR
435             update idletasks
436             after 500
437             $w tag remove blinkedline $i1 $i2
438             update idletasks
439             # do not wait when it's the last blink:
440             # control is given back to the caller ASAP
441             if {$i < $nb} {
442                 after 500
443             }
444         }
445     } else {
446         # function not found among opened buffers, do nothing
447     }
448 }