#!/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: xcursors.tk,v 1.3 2003/04/28 19:42:06 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.

#####################################################################
#
set file [open "/usr/include/X11/cursorfont.h" r]
set cursors {}
while {![eof $file]} {
  set line [gets $file]
  if {[regexp {^\#define XC_} $line]} {
    regsub {(^\#define XC_)} $line {} c
    lappend cursors $c
  }
}

#####################################################################
#
frame .control
button .exit -text Exit -command exit
label .help -text {Double klick on a cursor, to copy it's name to the clipboard}
label .name -textvariable cursor -bd 2 -relief sunken
pack .exit .help -side left -fill x -in .control
pack .name -side left -fill x -expand 1 -in .control
pack .control -fill x -expand 1

set pad 60
set x $pad
set y $pad
set bd [expr $pad/2-4]

canvas .c -bd 5 -relief groove \
    -width [expr $pad*14-10] -height [expr $pad*7-10]

pack .c -expand 1 -fill both

#####################################################################
#
set cursor {}
set selCursor {}
set selId {}

foreach e $cursors {
  set c [lindex $e 0]
  set n [lindex $e 1]

  catch {.c configure -cursor $c} err

  if {$err != ""} {
    .c create rectangle [expr $x-$bd] [expr $y-$bd] \
	[expr $x+$bd] [expr $y+$bd] -outline white -fill red
    puts $err
  } else {
    set id [.c create rectangle [expr $x-$bd] [expr $y-$bd] \
		[expr $x+$bd] [expr $y+$bd] -tags "$c" \
		-outline white -fill gray80]

    .c create text $x $y -font cursor -justify center \
	-text [format "%c" $n] -tag $c

    .c bind $c <Enter> ".c configure -cursor $c; set cursor $c"
    .c bind $c <Double-Button-1> [subst {
      .c itemconfigure $id -outline black;
      selection own .c selLoss;
      set selCursor $c;
      selLoss;
      set selId $id
    }]
  }

  incr x $pad

  if {$x > [expr $pad*13]} {
    incr y $pad
    set x $pad
  }
}

#####################################################################
#
proc selLoss {} {
  global selId
  if {$selId != ""} {
    .c itemconfigure $selId -outline white
  }
}

proc giveCursor {s e} {
  global selCursor
  string range $selCursor $s $e
}

#####################################################################
#

bind all <q> exit

selection handle .c  giveCursor