iconview as eTcl plugin

Richard Suchenwirth 2006-01-30 - Here's the viewIcons script that comes with the Icons library, greatly simplified and adapted for Sepp/eTcl on PocketPC (but it also runs on a desktop PC, just with a small window). Clicking on an icon places its textual (base64) representation in the clipboard, so you can conveniently paste it into your code.

 package req Tk
 #=======================================================================#
 # SCRIPT  : viewIcons.tcl                                               #
 # PURPOSE : Display icons from icon library.                            #
 # AUTHOR  : Adrian Davis ([email protected]).                         #
 #-----------------------------------------------------------------------#
 # HISTORY : Mar02 1.00.00 - First release.                              #
 #         : Jul02 1.01.00 - Adds clipboard and columns facilities.      #
 #         : Jan29 2006 suchenwi: adapted for PocketPC, simplified       #
 #=======================================================================#
 proc clipInfo {IconName} {
   global LIBRARY 
   set Data      {}
   set DataWidth 59
   set IconData [::icons::icons query -file $LIBRARY -items d $IconName]
   while {[string length $IconData] > 0} {
      append Data "\n   [string range $IconData 0 $DataWidth]"
      set IconData [string range $IconData [expr {$DataWidth + 1}] end]
   }
   set cmd "image create photo \
        $IconName -data {[string trimright $Data]\n}\n"
   clipboard clear
   clipboard append $cmd
   bell
 }
 proc selectIcons w {
   global INITIALDIR LIBRARY
   set OldLibrary   $LIBRARY
   set LIBRARY [tk_getOpenFile -initialdir $INITIALDIR \
        -initialfile tkIcons -title "Select Icon Library" \
        -filetypes {{"Icon Libraries" {tkIcons*}} {"All Files" {*}}}]
   if {$LIBRARY eq ""} {
      set LIBRARY $OldLibrary
   } else {displayIcons $w}
 }
 proc displayIcons c {
   global ICONS LIBRARY
   ::icons::icons delete $ICONS
   $c delete all
   set ICONS [::icons::icons create -file $LIBRARY -group *]
   set x 10
   set dx 28
   set y 14
   set dy 28
   foreach IconInfo [::icons::icons query -file $LIBRARY -group *] {
      set IconName  [lindex $IconInfo 0]
      set id [$c create image $x $y -image ::icon::$IconName]
      $c bind $id <1> [list clipInfo $IconName]
      if {[incr x $dx] > 210} {incr y $dy; set x 10}
   }
   $c config -scrollregion [$c bbox all]
 }

#-------------------- Main code

 proc iconview args {
   package require icons 1.0
   if [winfo exists .icons] {raise .icons; focus .icons; return}
   global LIBRARY ICONS INITIALDIR c
   if [llength $args] {
      set INITIALDIR [lindex $args 0]
   } else {
      set INITIALDIR [file dir [lindex [package ifneeded icons 1.0] 1]]
   }
   set ICONS    {}
   set LIBRARY  [file join $INITIALDIR tkIcons-sample.kde]

   set t [toplevel .icons]
   wm title $t "Icons"
   label  $t.1 -text Lib:
   entry  $t.2 -width 24 -textvariable LIBRARY
   bind   $t.2 <Return> displayIcons
   button $t.3 -text "Browse" -command {selectIcons $c} 
   grid $t.1 -row 0 -column 0 -padx 4
   grid $t.2 -row 0 -column 1
   grid $t.3 -row 0 -column 2 -padx 4 -pady 2 -sticky ew

   frame $t.f -borderwidth 0
   set c [canvas $t.f.icons \
        -yscrollcommand "$t.f.y set" -height 245 -width 220]
   bind $t <Up>   "$c  yview scroll -1 page"
   bind $t <Down> "$c  yview scroll  1 page"
   scrollbar $t.f.y -command "$c yview" -orient vertical
   pack      $t.f.y -side right -fill y
   pack      $c     -side left  -fill both -expand yes
   grid $t.f -row 1 -column 0 -columnspan 3 -sticky news
   displayIcons $c
   raise $t; focus -force $t
   catch {wce siphide}
 }

#-------------- self-test when sourced at toplevel:

 if {[file tail [info script]] eq [file tail $argv0]} {
   wm withdraw .
   iconview
   bind all <Escape> {exec wish $argv0 &; exit}
   bind all <F1>     {console show}
 }

Category Characters - Category Development