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