#!/bin/sh
# -*- tcl -*- \
    exec wish "$0" "$@"

# Copyright (C) 2001 Robert Fenk
#
# Author:      Robert Fenk
# X-URL:       http://www.robf.de/Hacking/TclTk.html
# X-RCS:       $Id: xchartab.tk,v 1.4 2003/04/28 19:39:13 fenk Exp $
#
# This code is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 1, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

proc setCharInfo {i} {
  global chartab
  set chartab(form) "  Hex: %2x\n  Oct: %03o\n  Dec: %3d\nASCII: %c\n Font: %s"
  
  .info delete 1.0 end
  .info insert end [format $chartab(form) $i $i $i $i $chartab(fontname)]
}

proc enterCharTabChar {id i} {
  global chartab
  .chartab itemconfigure $id -outline black
  setCharInfo $i
}

proc leaveCharTabChar {id i} {
  global chartab
  .chartab itemconfigure $id -outline white
  setCharInfo $i
}

proc getCharTabSel {o n} {
  global chartab
  return $chartab(sel)
}

proc createCharTab {} {
  global chartab
  
  set chartab(newfontname) {-*-fixed-medium-r-*-*-14-*-*-*-*-*-iso8859-*}
  set chartab(fontname) {-*-fixed-medium-r-*-*-14-*-*-*-*-*-iso8859-*}
  
  set pad 20
  set x 4
  set y 4
  set bd 10

  frame .buttons
  wm title . {Character Table}

  button .exit -text Exit -command {exit}
  button .font -text {Change Font} -command changeFont
  button .copy -text {Copy to Clipboard} -command {selection own .chartab}
  button .clear -text Clear -command {set chartab(sel) {}}
  text  .info  \
      -font {-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*} \
      -width 80 -height 5 -bd 2 -relief ridge
  entry .sel -textvariable chartab(sel) -font $chartab(fontname) \
      -bd 2 -relief sunken
    
  canvas .chartab -relief sunken -bd 2 \
      -width [expr $pad*32] -height [expr $pad*8]

  for {set i 0} {$i<256} {incr i} {
    global ed

    set id [.chartab create rectangle $x $y \
		[expr $x+$pad-1] [expr $y+$pad-1] \
		-tag "char$i" -outline white -fill gray80]
    
    if {($i >= 0 && $i <= 6) || ($i >= 14 && $i <= 31) || $i == 127} {
      set c ""
    } elseif {$i == 9} {
      set c "\\t"
    } else {
      set c [format "%c" $i]
    }

    set chartab($i) [.chartab create text [expr $x+$bd] [expr $y+$bd] \
			 -justify center -text $c \
			 -tag "char$i"]
    
    .chartab bind "char$i" <Enter> "enterCharTabChar $id $i"
    .chartab bind "char$i" <Leave> "leaveCharTabChar $id $i"
    .chartab bind "char$i" <Button-1> \
	"append chartab(sel) [format %c $i]; selection own .chartab"
    
    incr x $pad
    
    if {$x > [expr $pad*32]} {
      incr y $pad
      set x 4
    }
  }
  
  selection handle .chartab getCharTabSel

  pack .info -side top -fill x -in .buttons 
  pack .exit .font .copy .clear .sel -side left -in .buttons
  pack .buttons -fill x
  pack .chartab -fill both -expand 1

  trace variable chartab(newfontname) w changeCharTabFont
  bind .chartab <Destroy> {
    trace vdelete chartab(newfontname) w changeCharTabFont
  }

  changeCharTabFont chartab fontname w
}

proc changeCharTabFont {name1 name2 op} {
  if {![winfo exists .chartab]} return 

  global chartab

  set fn  $chartab(fontname)
  set nfn $chartab(newfontname)
  set chartab(fontname) $nfn

  if {$nfn=={}} return
  set fn $nfn
  
  setCharInfo 32
  .sel configure -font $fn

  for {set i 32} {$i<256} {incr i} {
    if {$i!=127 && $fn!={none}} {
      .chartab itemconfigure $chartab($i) -font $fn
    }
  }
}

proc changeFont {} {
  global chartab
  
  set s .select
  set lb  $s.lb
  set sbx $s.sbx
  set sby $s.sby
  set ok  $s.ok
  set ca  $s.cancle

  catch {destroy $s}
  toplevel $s
  
  frame $s.buttons
      
  button $ok -text Ok     -command {set chartab(newfontname) [selection get]}
  button $ca -text Cancle -command {set chartab(newfontname) {}}
  scrollbar $sbx -command "$lb xview" -width 10 -orient horizontal
  scrollbar $sby -command "$lb yview" -width 10
  listbox  $lb -width 80 -height 40 \
      -xscrollcommand "$sbx set" -yscrollcommand "$sby set" 

  bind $lb <Double-Button-1> {set chartab(newfontname) [selection get]}
  
  pack $s.buttons -fill x -side bottom
  pack $ok $ca -fill x -expand 1 -side left -in $s.buttons 
  pack $sbx -side bottom -fill x
  pack $sby -side right -fill y
  pack $lb -expand 1 -fill both

  set fl [open "| xlsfonts" r]
  set mark -1
  set i 0
  while {![eof $fl]} {
    set fontname [gets $fl]
    if {![string compare $fontname $chartab(fontname)]} {
      set mark $i
    }
    incr i
    $lb insert end $fontname
  }
  if {$mark >= 0} {
    $lb selection set $mark
    $lb see $mark
  }
  
  close $fl

  wm withdraw $s
  update idletask

  set x [expr [winfo screenwidth $s]/2 - [winfo reqwidth $s]/2 \
             - [winfo vrootx [winfo parent $s]]]
  set y [expr [winfo screenheight $s]/2 - [winfo reqheight $s]/2 \
             - [winfo vrooty [winfo parent $s]]]

  wm geometry $s +$x+$y
  wm deiconify $s

  set oldFocus [focus]
  grab $s
  focus $s

  global seced
  tkwait variable chartab(newfontname)
  destroy $s
  focus $oldFocus
  return $chartab(newfontname)
}

createCharTab