1# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
2#
3#       $Id: OpenMath.tcl,v 1.17 2011-03-15 01:13:22 villate Exp $
4#
5proc genSample { x n } {
6    set sample $x
7    set m 1
8    while { 1 } {
9	if { $m >= $n } { return $sample }
10    	if { [set tem [expr {2*$m}]] <= $n } {
11	    append sample $sample
12	    set m $tem
13	} else {
14	    return [append sample [genSample $x [expr {$n - $m}]]]
15	}
16    }
17}
18
19
20# font measuring is very slow so we cache the result of measuring a line
21# of x's.
22proc fontMeasure { font size } {
23    global  maxima_priv
24    set ll $maxima_priv(linelength)
25    if { ![catch {set answer [set $maxima_priv($font,$size,$ll)]} ] } { return $answer}
26    set sample [genSample x $ll]
27    set  maxima_priv($font,$size,$ll)  [font measure [list $font $size] $sample]
28    return $maxima_priv($font,$size,$ll)
29}
30
31proc getDefaultFontSize { width } {
32    global fixedFont
33    set answer "10 480"
34    catch {
35	set wid1 [fontMeasure $fixedFont 10]
36	set guess [expr {round($width/double($wid1) * 10.0)}]
37	while { [fontMeasure $fixedFont $guess] < $width && $guess <= 14 } {
38	    incr guess
39	}
40	incr guess -1
41	while { [fontMeasure $fixedFont $guess] > $width } { incr guess -1 }
42	set answer   [list $guess [fontMeasure $fixedFont $guess]]
43    }
44    return $answer
45
46}
47
48proc getMaxDimensions { } {
49    global embed_args
50    set dims "800 600"
51    if { [catch { set dims "$embed_args(width) $embed_args(height)" } ] } {
52	set dims "[expr round(.85* [winfo screenwidth .])] [expr round(.9* [winfo screenheight .])]"} else {
53	    set dims "[getPercentDim [lindex $dims 0] width .] [getPercentDim [lindex $dims 1] height .]"
54	}
55    return $dims
56}
57
58proc getPercentDim { dim direction win } {
59    if { [regexp {([0-9]+)%} $dim junk val] } {
60	set dim [winfo $direction $win]
61	catch { set dim [expr {round($val * $dim * .01)}] }
62	return $dim
63    }
64    return $dim
65}
66
67proc computeTextWinDimensions { win width height } {
68    # leave room for scroll bar
69    global fixedFont maxima_priv
70    # desetq "fsize wid" [getDefaultFontSize [expr {$width -15}]]
71    set wid $width
72    # set fixedFont [xHMmapFont font:fixed:normal:r:3]
73    set fsize [xHMfontPointSize $fixedFont]
74
75    set lh [expr {$fsize +1}]
76    catch {   set lh [font metrics $fixedFont -linespace] }
77    oset $win fixedFont $fixedFont
78    oset $win fontSize $fsize
79    oset $win width $width
80    oset $win width_chars $maxima_priv(linelength)
81    set hei [expr {round($height/$lh)}]
82    oset $win height_chars $hei
83    oset $win height [expr {$hei * $lh}]
84    oset $win lineheight $lh
85}
86
87
88
89proc setFontOptions { fsize }     {
90    global maxima_priv
91
92    global _fixed_default _prop_default fontSize
93    set helvetica $_prop_default
94    set courier $_fixed_default
95
96    global buttonfont entryfont labelfont fixedtextfont
97    set  buttonfont [font create -family $helvetica -size $fsize]
98    set  labelfont [font create -family $helvetica -size $fsize]
99    set  fixedtextfont [font create -family $courier -size $fsize]
100    set  entryfont [font create -family $courier -size $fsize]
101
102return
103
104    if { $fsize > 10 } { set fsize 12 }
105    if { $fsize == 8 } { set entrysize 10 } else {set entrysize $fsize }
106    #puts "fsize=$fsize"
107    catch {
108	#mike FIXME: these are broken for windows
109	set  buttonfont [font create -family Helvetica -size $fsize]
110	set  labelfont [font create -family helvetica -size $fsize]
111	set  fixedtextfont [font create -family courier -size $fsize]
112	set  entryfont [font create -family courier -size $fsize]
113
114	#mike: maxima should not be playing with these
115	# option add *Button.font $buttonfont
116	# option add *Label.font $labelfont
117	# option add *Entry.font $entryfont
118
119	option add  *Dialog.msg.wrapLength 500
120
121    }
122
123}
124proc omPanel { w args } {
125    global buttonfont entryfont labelfont maxima_priv
126
127    set top [winfo toplevel $w]
128    linkLocal $top omPanel
129    if { [info exists omPanel] } {return $omPanel }
130
131    set top [winfo parent $w]
132    #
133    if { "$top" == "." } { set top ""}
134    set win $top.textcommands
135    set omPanel $win
136    makeLocal $w fontSize
137    setFontOptions $fontSize
138
139    global [oarray $top.textcommands]
140    set menubar $top.textcommands
141    if { [winfo exists $menubar] } {
142	return $menubar
143    }
144    oset $win history ""
145    oset $win historyIndex 0
146    wmenubar $menubar
147    pack $menubar -side top -expand 1 -fill x -anchor nw
148
149    button $win.back -image ::img::previous -text [mc Back] -relief flat \
150        -width 30 -height 30 -command "OpenMathMoveHistory $win -1"
151    button $win.forward -image ::img::next -text [mc Forward] \
152	-relief flat -width 30 -height 30 -command "OpenMathMoveHistory $win 1"
153    pack $win.back $win.forward -side left -expand 0
154
155    global location
156    if {1} {
157	menubutton $win.url -image ::img::track -text Url: -relief flat \
158            -width 30 -height 30
159	menu $win.url.m -tearoff 0 \
160	    -postcommand [list vMaxOMUrlPostCommand $win $win.url.m]
161	$win.url configure -menu $win.url.m
162	pack $win.url -side left -fill both -expand 0
163	proc vMaxOMUrlPostCommand {win m} {
164	    $m delete 0 end
165	    foreach v [oget $win history] {
166		set url [oget $v location]
167		$m add command -label $url \
168		    -command [list OpenMathOpenUrl $url -commandpanel  $win]
169
170	    }
171	}
172    } else {
173	#mike slate the old histroy list for demolition
174	button $win.loclabel -text " Url:" \
175	    -command "OpenMathOpenUrl \[$win.location get\] -commandpanel  $win"
176	setHelp $win.loclabel [mc {Fetch the URL or FILE indicated in the entry box. \
177				   A local file is something like file:/home/wfs/foo.om, and a URL \
178				   begins with http.}]
179
180	pack $win.loclabel -side left -fill x -expand 0
181    }
182
183    entry $win.location -textvariable [oloc $win location] -width 40
184    setHelp $win.location [mc {Address of the current document.  You may modify it and type Enter, to fetch a new document.}]
185    bind $win.location <Key-Return> "OpenMathOpenUrl \[$win.location get\] -commandpanel  $win"
186    pack $win.location  -side left -fill x -expand 1
187    label $win.locspace -text " "
188    pack $win.locspace -side left -fill x -expand 0
189
190    oset $win history ""
191    pack $win -side top -expand 1 -fill x
192
193    oset $win status $maxima_priv(cStatusWindow)
194    return $win
195}
196
197proc forgetCurrent { win } {
198    makeLocal $win history historyIndex
199    set i 0
200    if { [llength $history] > 1 } {
201	set w [lindex $history $historyIndex]
202	set history [lreplace $history $historyIndex $historyIndex]
203	# might have caused two identical ones to be next to each other
204	if { "[lindex $history $historyIndex]" == "[lindex $history [expr {$historyIndex -1 }]]" } {
205	    set history [lreplace $history $historyIndex $historyIndex]
206	    set i -1
207	}
208	if { [lsearch  $history $w] < 0 } {
209	    after 2000 "destroy $w"
210	}
211	oset $win history $history
212	OpenMathMoveHistory $win $i
213    }
214}
215
216proc omDoStop { win } {
217    global maxima_priv
218    set st $maxima_priv(cStatusWindow)
219    set var [$st.scale cget -variable]
220    if { [regexp {sock[0-9]+} $var sock] } {
221	oset $sock done -1
222	if { ![catch { close $sock} ] } {
223
224	    append maxima_priv(load_rate) "--aborted"
225	}
226    }
227}
228
229
230
231
232
233#
234#-----------------------------------------------------------------
235#
236# setTypeForEval --  insert special editing of options, into MENU for PROGRAM
237#
238#  Results:
239#
240#  Side Effects:
241#
242#----------------------------------------------------------------
243#
244proc setTypeForEval { menu program } {
245    global maxima_priv
246    #puts "$menu program"
247    set slaves [pack slaves $menu.program ]
248    set men $menu.program.$program
249    if { [llength $slaves] > 0 } {eval pack forget $slaves}
250    if { ![catch { set options $maxima_priv(options,$program) } ] } {
251	if { ![winfo exists $menu.program.$program] } {
252	    #puts "options=$options"
253	    # puts "there"
254
255	    ### set up to add menu items to a new frame
256	    set key $menu.program
257
258	    frame $men
259	    rename $men $men-orig
260	    set body "wmenuInternal $key \$option \$args"
261	    oset $menu.program menu $men
262	    oset $men items ""
263	    oset $key parent $menu
264	    proc $men {option args } $body
265
266	    ##### end
267
268
269	    foreach v $options {
270		desetq "key dflt help" $v
271
272		if { [catch { set maxima_priv(options,$program,$key)} ] } {
273		    set maxima_priv(options,$program,$key) $dflt
274		}
275		switch [lindex $v 3] {
276		    boolean {
277			$men add check -label $key -variable maxima_priv(options,$program,$key) -help [concat $program option -$key: $help] -onvalue 1 -offvalue 0
278		    }
279		    default {
280            		$men add entry -label "$key:" -entryvariable maxima_priv(options,$program,$key) -help [concat $program option -$key: $help]
281
282		    }
283
284		}
285
286
287		#		label $new.label -text $key:
288		#		entry $new.entry  -textvariable maxima_priv(options,$program,$key)
289		#		pack $new.label $new.entry -side top -anchor w -fill x
290		#		pack $new -fill x
291		#		setHelp $new [concat $program option -$v: $help]
292
293	    }
294	}
295
296    }
297    catch { pack $men}
298
299}
300
301
302#
303#-----------------------------------------------------------------
304#
305# getGlobalOptions --  Convert the current global options for program,
306# to an option list:  -key1 value1 -key2 value2 ..
307#
308#  Results: the option list
309#
310#  Side Effects: none
311#
312#----------------------------------------------------------------
313#
314proc getGlobalOptions { program } {
315    global maxima_priv
316    set ans ""
317    if { ![catch { set options $maxima_priv(options,$program) } ] } {
318	foreach v $options {
319	    set key [lindex $v 0]
320	    set dflt [lindex $v 1]
321	    if { ![catch { set val $maxima_priv(options,$program,$key) }] } {
322		if { "$val" != "$dflt" } {
323		    lappend ans -$key $val
324		}
325	    }
326	}
327    }
328    return $ans
329}
330
331
332#
333#-----------------------------------------------------------------
334#
335# setGlobalOptions --  set the current global values of the options for PROGRAM
336# according to the values specified in OPTIONLIST.   If a value is not specified
337# use the value supplied in the defaults: $maxima_priv(options,$program)
338#
339#  Results:  none
340#
341#  Side Effects: the entries maxima_priv(options,$program,$key) are changed
342#  for each $key which is an option for program.
343#
344#----------------------------------------------------------------
345#
346proc setGlobalOptions { program list } {
347    global maxima_priv
348    if { [catch { set options $maxima_priv(options,$program) } ] } {
349	foreach  v $options {
350	    set key [lindex $v 0]
351	    set dflt [lindex $v 1]
352	    set $maxima_priv(options,$program,$key) \
353		[assoc -$key $list $dflt]
354	}
355    }
356}
357
358proc toggleEditBar  {win} {
359    makeLocal $win showEditBar editbar
360    if { [winfo viewable $editbar] }  {
361	pack forget $editbar
362	oset $win showEditBar "show edit bar"
363    } else {
364	pack $editbar -in $win -side bottom -expand 1 -fill x
365	oset $win showEditBar "hide edit bar"
366    }
367}
368
369
370proc getPrefixed { prefix  tags } {
371    set i [lsearch $tags ${prefix}*]
372    if { $i >= 0 } {
373	return [string range [lindex $tags $i] [string length $prefix] end]
374    } else {
375	return ""
376    }
377}
378
379proc programFromTags {tags} {
380    if {[lsearch $tags Teval ] < 0 } {
381	return ""
382    }
383    return [getPrefixed program: $tags]
384}
385
386proc saveToFile { commandPanel label file } {
387    makeLocal $commandPanel textwin
388    $label configure -relief sunken
389    set lab [$label cget -text]
390
391    # save just as text
392    set text [$textwin get 0.0 end]
393
394    if { [catch { set fi [open $file w] } err] } {
395	return -code error \
396	    [M [mc "Could not open file %s\n%s"] \
397		 [file native $file] $err]
398    }
399    puts $fi $text
400    close $fi
401    $label configure -relief raised -text [concat [mc "wrote"] "$file"]
402    after 1200 [list $label configure -text $lab]
403}
404
405if { [catch { package require Safesock } ] } {
406    catch { policy  home }
407    # catch {  policy outside }
408
409}
410
411
412proc mkOpenMath { win  } {
413    global    maxima_priv
414
415    set w $win
416    if {[winfo exists $w]} {catch {destroy $w}}
417    if { [catch { package require Safesock } ] } {
418	# policy network home
419	catch {  policy  outside }
420    }
421    desetq "width height" [getMaxDimensions]
422    computeTextWinDimensions $win $width $height
423
424    makeLocal $win fontSize width_chars height_chars fixedFont
425    set font $fixedFont
426
427    # puts "fontSize=$fontSize"
428    frame $w
429    set commandPanel [omPanel $w ]
430    oset $w commandPanel $commandPanel
431    set prevwindow ""
432
433    catch { set prevwindow [oget $commandPanel textwin] }
434
435    oset $commandPanel textwin $w.text
436
437    # pack $commandPanel -in $w -side top -fill x -pady 2m
438    # raise  $commandPanel
439
440    text $w.text -yscrollcommand "$w.scroll set" \
441	-selectbackground "#808080" \
442	-width $width_chars  -height $height_chars -font $font -wrap word
443    bind $w.text <Configure> "resizeSubPlotWindows $w.text %w %h"
444    set maxima_priv(currentwin) $w.text
445    set maxima_priv(point) end
446
447    $w.text tag bind "currenteval" <Leave> "$w.text tag remove currenteval 0.0 end ; addTagSameRange %W Teval currenteval @%x,%y;"
448    $w.text tag config "currenteval" -foreground red
449    $w.text tag bind Teval <Double-Button-1> {doInvoke %W @%x,%y }
450    $w.text tag bind Teval <Enter> {addTagSameRange %W Teval currenteval @%x,%y; textShowHelp %W Teval @%x,%y [mc "Double clicking (with the left mouse button), in the marked region will cause evaluation. "]}
451    $w.text tag bind Teval <Leave> {deleteHelp %W}
452    $w.text tag config hrule -font {Courier 1} -background black
453    $w.text mark set insert 0.0
454
455    # try "#d0d0d0" or "#ffffd0" or yellow
456
457    $w.text tag configure Teval -foreground blue -font $font  -border 1 -lmargin1 20
458
459
460
461    $w.text tag configure bold -font [xHMmapFont font:propor:bold:r:3] -lmargin1 15
462    $w.text tag configure plain -font [xHMmapFont font:propor:bold:r:3] -lmargin1 10
463    $w.text tag configure Tresult -font [xHMmapFont font:fixed:bold:r:3] -lmargin1 10
464    $w.text tag configure Tmodified -font [xHMmapFont font:fixed:normal:r:3] -background pink -relief sunken -border 1
465    $w.text tag configure Thref -font [xHMmapFont font:fixed:normal:r:3]  -foreground blue  -relief flat
466
467    set lh [oget $win lineheight]
468    $w.text tag configure sub -offset [expr {-round($lh*.6) }]
469    $w.text tag configure sup -offset [expr {round($lh*.6) }]
470
471
472    oset $w.text counter 0
473    # allow some openmath text bindings to take precedence
474    bindtags $w.text "OpenMathText [bindtags $w.text]"
475    scrollbar $w.scroll -command "$w.text yview"
476
477    pack $w.scroll -side right -fill y
478    pack $w.text -expand 1  -fill both
479    pack $w -expand 1 -fill both
480
481    if {[winfo exists $prevwindow] } { pack forget [winfo parent $prevwindow] }
482    return  $w.text
483
484}
485
486#source emaxima.tcl
487#source egp.tcl
488
489# Create bindings for tags.
490
491# set ActiveTags {
492#   gap-eval
493#   gap-eval-insert
494#   octave-eval
495#   octave-eval-insert
496#   face-jump-to-bkmark
497#   xlsp-eval
498#   xlsp-eval-insert
499#   gcl-eval
500#   gcl-eval-insert
501#   emacs-lisp-eval
502#   emacs-lisp-eval-insert
503#   mma-eval
504#   mma-eval-insert
505#   Splus-eval
506#   Splus-eval-insert
507#   gp-eval
508#   gp-eval-insert
509#   maple-eval
510#   maple-eval-insert
511#   shell-eval-region
512#   gnuplot-eval
513#   xplot-eval
514#   maxima-eval
515#   maxima-eval-insert
516#   dfplot-eval
517#   book-shell-eval-insert
518#   book-image-insert
519#   book-postscript-insert
520#   book-tex-math-mode
521#   book-elisp-eval
522#   book-shell-eval
523#  }
524
525global evalPrograms
526# add in Toctave, Topenplot, Thref etc... ie ones with eval_* defined
527foreach v [info proc insertResult_*] {
528    lappend evalPrograms [string range $v 13 end]
529}
530
531
532#
533#-----------------------------------------------------------------
534#
535# defaultInsertMode --  each program can have a default insert mode.
536#  If the insert method is not noted specifically then it uses the default.
537#  maxima and gp have default to insert.
538#  Results: 0 or 1
539#
540#  Side Effects: none
541#
542#----------------------------------------------------------------
543#
544proc defaultInsertMode { program } {
545    global maxima_priv
546    if { [catch {  set dflt [getOptionDefault doinsert $maxima_priv(options,$program)]} ] } { return 1}
547
548    if { "$dflt" == "" } {set dflt  1}
549    return $dflt
550}
551
552proc doInsertp { tags } {
553    set program [programFromTags $tags]
554    # puts "program=$program," ; flush stdout
555    return [getEvalArg -doinsert $tags [defaultInsertMode [programName $program]]]
556}
557
558
559#
560#-----------------------------------------------------------------
561#
562# doInvoke --  invoked when user clicks on WINDOW at INDEX
563# this will either call the program whose tag is in the list of
564# tags at this point, on the expression which is highlighted for this
565# or else call the special code in eval_$program if the latter exists.
566#  Results: none
567#
568#  Side Effects: The modified result of the insert field will be cleared,
569#  and the value there will be changed.
570#----------------------------------------------------------------
571#
572proc doInvoke { w index } {
573    global evalPrograms MathServer
574    set tags [$w tag names $index]
575
576    $w tag delete sel
577
578    set program [programFromTags $tags]
579    if { "$program" == "" } {
580	return
581    }
582    # puts "base=[oget $w baseprogram],w=$w"
583    set res [resolveURL $program [oget $w baseprogram]]
584    # puts "program=$program,baseprogram[oget $w baseprogram],res=$res"
585
586    set MathServer "[assoc server $res [lindex $MathServer 0]] \
587	   [assoc port $res [lindex $MathServer 1]]"
588    set this [thisRange $w  program:$program $index]
589    # puts "this=$this"
590
591    set nextResult ""
592    set doinsert [doInsertp $tags]
593    # puts "doinsert=$doinsert"
594
595    if { $doinsert} {
596	set name [getPrefixed name: $tags]
597	if { "$name" != "" } {
598	    set nextResult [$w tag nextrange result:$name [lindex $this 1]]
599	    if { 0 == [llength $nextResult] } {
600		error [concat [mc "No result field with"] "name=$name"]
601	    }
602	} else {
603	    set next [$w tag nextrange Teval [lindex $this 1]]
604	    set nextResult [$w tag nextrange Tresult [lindex $this 1]]
605	    if {
606		[llength $nextResult] == 0
607		||    ([llength $next] !=0
608		       &&  [$w  compare [lindex $nextResult 0] > [lindex $next 0]] )
609	    } {
610		$w insert "[lindex $this 1]+1 char" " " "Tresult"
611		set nextResult [$w tag nextrange Tresult [lindex $this 1]]
612		# error "no place to put result"
613	    }
614	}
615	if { "$nextResult" != "" } {
616	    eval $w  tag add Tmodified $nextResult
617	}
618    }
619    set prog [programName $program]
620    if { [info proc eval_$prog] != "" } {
621	if {[eval_$prog $program $w $this $nextResult] != 0 }  {
622	    error [mc "Failed to eval region"]
623	}
624    } else {
625	global err
626	if { [catch { sendOneInsertTextWin $program [eval $w get $this] $w $this $nextResult} err ] && [regexp "Can't connect" $err ]} {
627	    global maxima_default
628	    set now [encodeURL [oget $w baseprogram] ]
629	    set tem [ldelete $now $maxima_default(defaultservers)]
630	    if { [tk_dialog .jil 0 "$err: connect to one of $tem?" "" 0 change "keep $now"] == 0 } {
631		set maxima_default(defaultservers)  $tem
632		oset $w baseprogram [decodeURL [getBaseprogram]]
633		doInvoke $w $index
634		return
635	    } else {
636		return
637	    }
638
639	}
640    }
641
642
643}
644
645proc getEvalArg { key names {dflt ""} } {
646
647    foreach v $names {
648	if { "[string range $v 0 5]" == "Targs "} {
649	    return [assoc $key [lrange $v 1 end] $dflt]
650	}
651    }
652    return $dflt
653}
654
655
656#
657#-----------------------------------------------------------------
658#
659# setModifiedFlag --  add the Tmodified tag to the next Tresult field
660#  after the current expression.
661#  Results:
662#
663#  Side Effects:
664#
665#----------------------------------------------------------------
666#
667proc setModifiedFlag { win index } {
668    if { [lsearch [$win tag names $index] Teval] >= 0 } {
669	set next [$win tag nextrange Tresult $index]
670	if { "$next" != "" } {
671	    eval $win  tag add Tmodified $next
672	}
673    }
674}
675
676
677#
678#-----------------------------------------------------------------
679#
680# insertResult --  replace RESULTRANGE of the text buffer by VALUE,
681#  and clear the Tmodified tag if there is one.
682#  most eval_$program programs will call this to insert their result.
683#  Results:
684#
685#  Side Effects:
686#
687#----------------------------------------------------------------
688#
689proc insertResult { w resultRange value } {
690    set tags [$w tag names [lindex $resultRange 0]]
691    set value [xHMuntabify $value]
692    # append a newline to a multiline result that has no newline after it.
693    if { [regexp "\n.*\[^\n]\$" $value ] } {append value "\n"}
694    eval $w delete $resultRange
695    # dont lose the whole thing!!
696    if { "$value" == "" } { set value " "}
697    $w insert [lindex $resultRange 0] $value  [ldelete Tmodified $tags]
698}
699
700
701
702
703#
704#-----------------------------------------------------------------
705#
706# addPreloads --  Tack any preloads or preevals on to the
707#  command.
708#  Results: the new COMMAND
709#
710#  Side Effects:
711#
712#----------------------------------------------------------------
713#
714proc addPreloads {command program win this } {
715    set preload [getTagsMatching $win ^pre(load|eval):* $this]
716    if { "$preload" != "" &&  ![preeval $program $preload] } {
717	if { [regexp \{pre(load|eval):(.*)\} $preload junk op url] ||
718	     [regexp pre(load|eval):(.*) $preload junk op url]} {
719	    if { "$op" == "load" } {
720		set res [HMgetURL $win $url type]
721		append res $command
722		set command $res
723	    } else {
724		append url $command
725		set command $url
726	    }
727
728	}
729    }
730    return $command
731}
732
733
734#
735#-----------------------------------------------------------------
736#
737# sendOneInsertTextWin --  send PROGRAM the COMMAND for insertion
738# in the text window WIN at RANGE.   There may be a program specific
739# insertResult_maxima, .. in which case this does the job.   It
740# is also passed the field of where the command came from.
741# We mark these fields with a tag, since they may get moved by typing
742# before the result comes back.   The com:* tags also provide omDoAbort
743# with the program names that are currently active, so that it can abort.
744#  Results:
745#
746#  Side Effects: until the evaluation succeeds the tags
747#  res:pdata($PROGRAM,result,$i) and a similar com: indicate the
748#  result field, and the command field.
749#
750#----------------------------------------------------------------
751#
752proc sendOneInsertTextWin { program command win this range} {
753    set eval [getTagsMatching $win ^eval(sub|):* $this]
754    if { "$eval" != "" } {
755	if { [regexp \{eval(sub|):(.*)\}  $eval junk op val ]  } {
756	    if { "$op" == "sub" } {
757		regsub -all "\\&" $val $command val
758	    }
759	    set command $val
760	}
761    }
762    set command [addPreloads $command $program $win $this ]
763
764    # puts "preload=$preload,command:$command"
765    set loc [sendOneDoCommand $program $command "sendOneInsertTextWin1 $win $program "]
766    if { "$range" != "" } {
767	$win tag add res:$loc [lindex $range 0] [lindex $range 1]
768    }
769    $win tag add com:$loc [lindex $this 0] [lindex $this 1]
770}
771
772proc sendOneInsertTextWin1 { win program location } {
773    #puts "entering trace:sendOneInsertTextWin1 $win $location"
774    #flush stdout
775    message "received result"
776    set resultRange [$win tag nextrange res:$location 0.0]
777    set this [$win tag nextrange com:$location 0.0]
778    $win tag delete res:$location com:$location
779    #    if { "$resultRange" == ""} {
780    #	puts "somebody removed result place for $location"
781    #	return ""
782    #    }
783
784    if {[info command insertResult_[programName $program]] != "" } {
785	insertResult_[programName $program] \
786	    $win $this $resultRange \
787 	    [uplevel "#0" set $location]
788    } else {
789	insertResult $win $resultRange [uplevel "#0" set $location]
790    }
791    uplevel "#0" unset $location
792}
793
794
795proc xHMuntabify { s } {
796    set lis [split $s \n]
797    set ans [lindex $lis 0]
798    foreach v [lrange $lis 1 end] {
799	append ans \n[xHMuntabifyLine $v]
800    }
801    return $ans
802}
803
804proc xHMuntabifyLine { s } {
805    set l [split $s \t]
806    set ans [lindex $l 0]
807    set rest [lrange $l 1 end]
808    foreach w $rest {
809	set n [expr {[string length $ans]%8}]
810	append ans [string range "        " $n end]
811	append ans $w
812    }
813    return $ans
814}
815
816
817#
818#-----------------------------------------------------------------
819#
820# textBbox --  Compute the bounding box of a range of characters
821# starting at IND1 and running to IND2.
822#
823#  Results: return "x y width height" where x, y are the coordinates
824#  of the upper left corner.
825#
826#  Side Effects:
827#
828#----------------------------------------------------------------
829#
830proc textBbox { win ind1 ind2 } {
831
832    foreach i { 1 2 } {
833	set ind [eval $win index [set ind$i]]
834	set ind$i $ind
835	set line$i [lindex [split $ind .] 0]
836	if { [catch {desetq "x$i y$i xdim$i ydim$i" [eval $win bbox $ind]}] } {
837	    # not visible
838	    return ""}
839    }
840    if { $line1 == $line2 } {
841	return "$x1 $y1 [expr {$x2-$x1+$xdim2}] [expr {$y2-$y1+$ydim2}]"
842    } else {
843	set xrange "$x1 $x2+$xdim2"
844	set yrange "$y1 $y2+$ydim2"
845
846	for { set j $line1 } { $j < $line2 } { incr j } {
847	    desetq "x y xdim ydim" [$win dlineinfo $j.0]
848	    set xrange [minMax $xrange $x [expr {$x + $xdim}]]
849	    set yrange [minMax $yrange $y [expr {$y + $ydim}]]
850	}
851	desetq "x y xdim ydim" [$win dlineinfo $line2.0]
852	set xrange [minMax $xrange $x [expr {$x + $xdim}]]
853	set yrange [minMax $yrange [expr {$y + $ydim}]]
854	desetq "x1 x2 y1 y2" "$xrange $yrange"
855	return "$x1 $y1 [expr {$x2 - $x1}] [expr {$y2 - $y1}]"
856
857    }
858}
859
860proc textShowHelp { win tag index msg } {
861    set this [thisRange $win $tag $index]
862    if { "$this" == "" } { return }
863    set tags [$win tag names $index]
864    if { "$tag" == "Teval" } {
865	set program [programFromTags $tags]
866	if { "$program" != ""} {
867	    set msg [string trimright $msg ". "]
868	    append msg [M [mc " by %s."] "$program"]
869	}
870	if { [doInsertp $tags] } {
871	    append msg [mc " The result will be inserted."]
872	}
873	if { "[getPrefixed name: $tags]" != "" } {
874	    append msg [concat [mc "  The result field is named"] "`[getPrefixed name: $tags]'."]
875	}
876    }
877    if { [catch { desetq "x y wid hei" [eval textBbox $win  $this] } ] } {
878	# cant get position
879	return ""
880    }
881    set top [winfo toplevel $win]
882
883    set x [expr {$x + [winfo rootx $win] - [winfo rootx $top]}]
884    set y [expr {$y + [winfo rooty $win] - [winfo rooty $top]}]
885
886    #puts "showHelp $win $x $y $wid $hei"
887    #mike FIXME: $arg1 is a list not a window
888    showHelp "$win $x $y $wid $hei" $msg
889}
890
891proc getTagsMatching { win regexp range } {
892    foreach ind $range {
893	foreach v [$win tag names $ind] {
894	    if { [regexp -- $regexp $v] } {
895		set there($v) 1
896	    }
897	}
898    }
899    set dump [eval $win dump -tag $range]
900    set i 1
901    set ll [llength $dump]
902    while { $i < $ll } {
903	set v [lindex $dump $i]
904	if { [regexp -- $regexp $v] } {
905	    set there($v) 1
906	}
907	incr i 3
908    }
909    return [array names there]
910}
911
912proc markForProgram { w args } {
913    global evalTags
914    set win [omPanel $w]
915    set program [assoc -program $args [oget $win currentProgram]]
916    set range [assoc -range $args [$w tag nextrange sel 0.0]]
917    if { "$range" == ""} {
918	return ""
919    }
920    set tags [assoc -tags $args ""]
921    if { "$tags" == ""} {
922	set tags [list Teval program:$program ]
923	set opts [getGlobalOptions [programName $program]]
924	if { "$opts" != ""} {  lappend tags [concat Targs $opts] }
925    }
926    # puts "tags=$tags"
927    eval $w tag remove Teval $range
928    foreach v [getTagsMatching $w "^Targs |^program:" $range] {
929	eval $w tag remove [list $v] $range
930    }
931    foreach v $tags {eval $w tag add [list $v] $range}
932    set insert [doInsertp $tags]
933    if { $insert } {
934	set nextResult [$w tag nextrange Tresult [lindex $range 1]]
935	set next [$w tag nextrange Teval [lindex $range 1]]
936	if { [llength $nextResult] == 0 ||
937	     ([llength $next] !=0)
938	     &&  [$w compare [lindex $nextResult 0] > [lindex $next 0]] } {
939
940	    set templates [list " yields " " evaluates to "  \
941			       " returns " " produces " " gives "]
942	    $w mark set tmp [lindex $range 1]
943
944	    $w insert tmp [lindex $templates [expr {[clock clicks]%[llength $templates]}]] plain
945	    $w insert tmp RESULT {Tresult Tmodified}
946	    $w insert tmp " "  {plain}
947	} else {
948	    apply $w tag add Tmodified $nextResult
949	}
950
951    }
952}
953
954## endsource preamble.tcl
955
956