# Make sure the html widget is loaded into
# our interpreter
#

# global GIDDEFAULT
# if {[info command html]==""} {
#   #if {![package require tkhtml]} return
#   foreach f {
#     ./tkhtml.so
#     /usr/lib/tkhtml.so
#     /usr/local/lib/tkhtml.so
#     tkhtml.dll
#   } {
#     if {[file exists $f]} {
#       if {[catch {load $f Tkhtml}]==0} break
#     }
#   }
# }



# The HtmlTraceMask only works if the widget was compiled with
# the -DDEBUG=1 command-line option.  "file" is the name of the
# first HTML file to be loaded.
#
set HtmlTraceMask 0
set showImages 1
set file ""


#foreach a $argv {
#  if {[regexp {^debug=} $a]} {
#    scan $a "debug=0x%x" HtmlTraceMask
#  } else {
#    set file $a
#  }
#}


# These images are used in place of GIFs or of form elements
#
image create photo biggray -data {
    R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
}
image create photo smgray -data {
    R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9m0VADv/
}
image create photo nogifbig -data {
    R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
    AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
    HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
    FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
}
image create photo nogifsm -data {
    R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
    3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
}




# If the tracemask is not 0, then draw the outline of all
# tables as a blank line, not a 3D relief.
#
if {$HtmlTraceMask} {
  $finestra config -tablerelief flat
}

# A font chooser routine.
#
# $finestra config -fontcommand pickFont
proc pickFont {size attrs} { 
  puts "FontCmd: $size $attrs"
  set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
  set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
  set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
  set d [expr {int(12*pow(1.2,$size-4))}]
  list $a $d $b $c
} 

# This routine is called for each form element
#
proc FormCmd {n cmd args} {
  # puts "FormCmd: $n $cmd $args"
  switch $cmd {
    select -
    textarea -
    input {
      set w [lindex $args 0]
      label $w -image nogifsm
    }
  }
}

# This routine is called for every <IMG> markup
#
# proc ImageCmd {args} {
# puts "image: $args"
#   set fn [lindex $args 0]
#   if {[catch {image create photo -file $fn} img]} {
#     return nogifsm
#   } else {
#    global Images
#    set Images($img) 1
#    return $img
#  }
#}

proc ResolverCmd { args } {
    global var
    
    set uri [lindex $args 1]
    if ![string compare [file pathtype $uri] "relative"] {
	set uri [file join $var(path_manual) $uri]
    }

    #WarnWinText $retURIES

    return $uri
}

proc ImageCmd {args} {
  global OldImages Images showImages var

  if {!$showImages} {
    return smgray
  }

    #WarnWinText "ImageCmd: $args"

    set fn [lindex $args 0]

    #set fn "$var(path_manual)/[lindex [lindex $args 3] 1]"

  if {[info exists OldImages($fn)]} {
    set Images($fn) $OldImages($fn)
    unset OldImages($fn)
    return $Images($fn)
  }
  if {[catch {image create photo -file $fn} img]} {
    return smgray
  }
  if {[image width $img]*[image height $img]>20000} {
    global BigImages
    set b [image create photo -width [image width $img] \
           -height [image height $img]]
    set BigImages($b) $img
    set img $b
    after idle "MoveBigImage $b"
  }
  set Images($fn) $img
  return $img
}
proc MoveBigImage b {
  global BigImages
  if {![info exists BigImages($b)]} return
  $b copy $BigImages($b)
  image delete $BigImages($b)
  unset BigImages($b)
  update
}


# This routine is called for every <SCRIPT> markup
#
proc ScriptCmd {args} {
  # puts "ScriptCmd: $args"
}

# This routine is called for every <APPLET> markup
#
proc AppletCmd {w arglist} {
  # puts "AppletCmd: w=$w arglist=$arglist"
  label $w -text [_ "The Applet %s" $w] -bd 2 -relief raised
}

# 
# HrefBinding s'executa quan hi ha un link des del frame HTML.
# El link es guarda a la llista $var(history) per seguir el
# rastre dels moviments de l'usuari (botons back i forw)
# Els links cap a mailto, http o al fitxer TableOfContents (TOC)
# no es permeten

proc HrefBinding {x y finestra} {
    cursor_wait
    set new [$finestra href $x $y]
    
    # truco raro para eliminar {{}} que aparecen en el click
    if {[llength $new] == 1} {
	set new [lindex $new 0]
    }    
    if {[llength $new] == 1} {
	set new [lindex $new 0]
    }
    # fin truco raro

    if {$new!="" && ![regexp {TOC} $new] && ![regexp {mailto} $new] && ![regexp {http} $new]} {    
  	global LastFile var

        if {$var(pos_history) != 1} {
            set var(history) [lreplace $var(history) [expr [llength $var(history)] - $var(pos_history)+1] end ] }
        lappend var(history) $new
        set var(pos_history) 1


        #if {[regexp {([a-z]*)(.html#SEC)(([0-9]+)*)} $new tot text ref num]} {
        #     set var(node_actual) $num   }


	set pattern $LastFile#
	set len [string length $pattern]
	incr len -1
	if {[string range $new 0 $len]==$pattern} {
	    incr len
	    $finestra yview [string range $new $len end]
	} elseif { [regexp {(.*)#(.*)} $new {} file tag] } {
	    LoadFile $file $tag
	} else {
	    LoadFile $new
	}
    }
cursor_normal
}


# 
#  IndexLink s'executa quan hi ha un link des de l'arbre
#  de continguts o des de qualsevol altre lloc.
#  No cal guardar el link a la llista $var(history), es fa 
#  abans de cridar aquesta funcio.
#

proc IndexLink {new finestra} {


    if {$new!=""} {
        cursor_wait
	global LastFile 

	#WarnWinText $new

        set pattern $LastFile#
	set len [string length $pattern]
	incr len -1
	if {[string range $new 0 $len]==$pattern} {
	    incr len
	    $finestra yview [string range $new $len end]
	} elseif { [regexp {(.*)#(.*)} $new {} file tag] } {
	    LoadFile $file $tag
	} else {
	    LoadFile $new
	}
    }
    $finestra xview moveto 0.0
    cursor_normal

}

# This procedure is called when the user selects the File/Open
# menu option.
#
set lastDir [pwd]
proc Load {} {
  set filetypes {
    {{Html Files} {.html .htm}}
    {{All Files} *}
  }
  global lastDir htmltext
  set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
  if {$f!=""} {
    LoadFile $f
    set lastDir [file dirname $f]
  }
}

# Clear the screen.
#
# Clear the screen.
#
proc Clear {} {
  global Images OldImages hotkey finestra
  if {[winfo exists .fs.h]} {set w .fs.h} {set w $finestra}
  $w clear
  catch {unset hotkey}
  ClearBigImages
  ClearOldImages
  foreach fn [array names Images] {
    set OldImages($fn) $Images($fn)
  }
  catch {unset Images}
}
proc ClearOldImages {} {
  global OldImages
  foreach fn [array names OldImages] {
    image delete $OldImages($fn)
  }
  catch {unset OldImages}
}
proc ClearBigImages {} {
  global BigImages
  foreach b [array names BigImages] {
    image delete $BigImages($b)
  }
  catch {unset BigImages}
}

# Read a file
#
proc ReadFile {name} {
  if {[catch {open $name r} fp]} {
    tk_messageBox -icon error -message $fp -type ok
    return {}
  } else {
    fconfigure $fp -translation binary
    set r [read $fp [file size $name]]
    close $fp
    return $r
  }
}

# Load a file into the HTML widget
#

proc LoadFile {name { tag "" } } {
    global LastFile finestra

    if { $name == "" } { return }

    # dirty trick for references that only contain the tag
    if { [info exists LastFile] && [string equal [file join $name] [file dirname $LastFile]] } {
	set name $LastFile
    }

    set html [ReadFile $name]
    if {$html==""} return
    Clear
    set LastFile $name

    $finestra config -base $name
    if [string length $tag] {
	set name "$name\#$tag"
    }

    $finestra parse $html
    ClearOldImages
    if { $tag != "" } {
	$finestra draw disabled
	update idletasks
	$finestra draw enabled
	$finestra yview $tag
    }
}

# Refresh the current file.
#
proc Refresh {args} {
  global LastFile
  if {![info exists LastFile]} return
  LoadFile $LastFile
}

# If an arguent was specified, read it into the HTML widget.
#
update
if {$file!=""} {
  LoadFile $file
}


# This binding changes the cursor when the mouse move over
# top of a hyperlink. 
# Si el link es un link cap al fitxer TableOfContents (TOC),
# s'ignora, el cursor no canvia.


bind HtmlClip <Motion> {
  set parent [winfo parent %W]
  set url [$parent href %x %y]

  if {[string length $url] > 0 && ![regexp {TOC} $url] && ![regexp {mailto} $url] && ![regexp {http} $url]} {
    $parent configure -cursor hand2
  } else {
    $parent configure -cursor {}
  }
}


#
#  Managing Selection ...
#
#

proc ManageSel { htmlw w x y type } {
    global HelpPriv tcl_platform

    if { ![winfo exists  $w] } { return }
    if { [winfo parent $w] != $htmlw } { return }
    if { [info exists HelpPriv(lastafter)] } {
	after cancel $HelpPriv(lastafter)
    }
    if { ![info exists HelpPriv(lastselectionidx)] } {
	set HelpPriv(lastselectionidx) 0
    }
    switch -glob $type {
	press {
	    update idletasks
	    $htmlw sel clear
	    set HelpPriv(lastselectionidx) [$htmlw index @$x,$y]
	    $htmlw sel set [$htmlw index @$x,$y] [$htmlw index @$x,$y]
	}
	motion* {
	    if { $type == "motion" } {
		#set ini [$htmlw index sel.first]
		set ini $HelpPriv(lastselectionidx)
		if { $ini == "" } { 
		    $htmlw sel clear
		} else {
		    set idx [$htmlw index @$x,$y]
		    if { $idx <= $ini } {
			$htmlw sel set $idx $ini
		    } else {
		        catch {
			$htmlw sel set $ini $idx
			}
		    }
		}
	    }
	    set isout 0
	    if { $x > [winfo width $htmlw] } {
		$htmlw xview scroll 1 units
		set isout 1
	    } elseif { $x <0 } {
		$htmlw xview scroll -1 units
		set isout 1
	    }
	    if { $y > [winfo height $htmlw] } {
		$htmlw yview scroll 1 units
 #  tkMessageBox -message "$y  [winfo height $htmlw]"

		set isout 1
	    } elseif { $y <0 } {
		$htmlw yview scroll -1 units
		set isout 1
	    }
	    if { $isout } {
		set HelpPriv(lastafter) [after 100 ManageSel $htmlw $w $x $y motionout]
	    }
	}
	release {
	    #set ini [$htmlw index sel.first]
	    set ini $HelpPriv(lastselectionidx)
	    if { $ini == "" } { 
		$htmlw sel clear
		return
	    }
	    set idx [$htmlw index @$x,$y]
	    if { $idx == $ini } {
		$htmlw sel clear
	    } else {
		if { $idx <= $ini } {
		    catch {
			$htmlw sel set $idx $ini
		    }
		} else {
		    catch {
			$htmlw sel set $ini $idx
		    }
		}
	    }
	    if { $tcl_platform(platform) != "windows"} {
		selection own -command "LooseSelection $htmlw" $htmlw
	    }
	}
	
    }
}


proc LooseSelection { w } {
    $w sel clear
}

proc CopySelected { w { offset 0 } { maxBytes 0} } {
    global tcl_platform

    set ini [$w index sel.first]
    set end [$w index sel.last]
    if { $ini == "" || $end == "" } { return }

    regexp {([0-9]+)[.]([0-9]+)} $ini {} initoc inipos
    regexp {([0-9]+)[.]([0-9]+)} $end {} endtoc endpos
    #puts [$w token list $initoc $endtoc]
    set rettext ""
    set iposlast [expr $endtoc-$initoc]
    set ipos 0
    foreach i [$w token list $initoc $endtoc] {
	set type [lindex $i 0]
	set contents [lrange $i 1 end]
	switch -- $type {
	    Text {
		set inichar 0
		set endchar [string length $contents]
		if { $ipos == 0 } {
		    set inichar $inipos
		}
		if { $ipos == $iposlast } {
		    set endchar [expr $endpos-1]
		}
		append rettext [string range $contents $inichar $endchar]
	    }
	    Space {
		if { [lindex $contents 1] == 0 } {
		    append rettext " "
		} else {
		    append rettext "\n"
		}
	    }
	}
	incr ipos
    }
    if { $tcl_platform(platform) == "windows"} {
	clipboard clear -displayof $w
	clipboard append -displayof $w $rettext
    } else {
	return [string range $rettext $offset [expr $offset+$maxBytes-1]]
    }
}

proc cursor_wait {} {
global var
set w $var(win)

	$w.esq.index.tree configure -cursor watch
        $w.dreta.fondo.html configure -cursor watch
	$w configure -cursor watch
	update
}


proc cursor_normal {} {
global var
set w $var(win)

	$w.esq.index.tree configure -cursor hand2
	$w configure -cursor arrow
        $w.dreta.fondo.html configure -cursor arrow
	update
}