DatabaseListbox
DatabaseSearchListbox
Listbox
Notepad
PasswordBox
TextClass
Thermometer
ToplevelListbox
about_neosoft
add_pulldown
add_pulldown_separator
bind_pulldown_menus
center_window
combine_widgetnames
create_pulldown_menu
create_scrollable_canvas
fileselect
fileselect.default.cmd
kfileselect
list_listbox_subwindow
list_subwindow_cancel
list_subwindow_ok
modal_dialog
modal_dialog_bitmap
neosoft:font1:crack_fonts
neosoft:font1:create_font_selector
neosoft:font1:create_font_tag
neosoft:font1:drop_fontinfolist
neosoft:font1:drop_fontlist
neosoft:font1:drop_fontsizelist
neosoft:font1:dump_fonts
neosoft:font1:get_current_font_string
neosoft:font1:set_font_defaults
neosoft_init
DatabaseListbox - an [incr tcl] class
DatabaseListbox object
inherits ToplevelListbox TSV
object query
arrayName fields expression
object record_matched
fields object offset arrayName
# # Superclass containing a TSV database and a toplevel listbox. # inherit ToplevelListbox TSV constructor {config} { ToplevelListbox::constructor TSV::constructor } method query {arrayName fields expression} { empty upvar $arrayName x TSV::query x $fields $expression "$this DatabaseListbox::record_matched [list $fields]" } method record_matched {fields object offset arrayName} { upvar $arrayName x set result "" foreach fieldName $fields { lappend result $x($fieldName) } add $result [location_of_last_record] }
DatabaseSearchListbox - an [incr tcl] class
DatabaseSearchListbox object
inherits TSVsearcher DatabaseListbox
object matches
nMatches
object searchtext
text
object build_searchframe
w
object search_from_entry
object search
pattern searchtextUpdate 1
object record_matched
key
# # Superclass containing a TSV database index search and a toplevel listbox. # inherit TSVsearcher DatabaseListbox constructor {config} { DatabaseListbox::constructor TSV::constructor TSVsearcher::constructor build_searchframe $windowName } method matches {nMatches} { $matchframe.matches configure -text $nMatches } method searchtext {text} { $searchframe.entry delete 0 end $searchframe.entry insert 0 $text } method build_searchframe {w} { set searchframe $w.searchframe frame $searchframe pack $searchframe -side top -fill x button $searchframe.button -text "Search" -command "$this search_from_entry" pack $searchframe.button -side left entry $searchframe.entry -width 20 -relief sunken pack $searchframe.entry -side left -fill x set matchframe $w.matchframe frame $matchframe pack $matchframe -side top -fill x label $matchframe.label -text "Matches" pack $matchframe.label -side left label $matchframe.matches -width 5 -text 0 -relief raised pack $matchframe.matches -side left bind $searchframe.entry <Return> "$this search_from_entry" } method search_from_entry {} { search [$searchframe.entry get] 0 } method search {pattern {searchtextUpdate 1}} { if {$searchtextUpdate} {searchtext $pattern} empty matches "-----" update TSVsearcher::search *$pattern* var {$this DatabaseSearchListbox::record_matched $var} -glob matches [size] } method record_matched {key} { add $key [locate $key] } protected searchframe protected matchframe
Listbox - an [incr tcl] class
Listbox object -title something -callback {} -indexCallback {} -saveCallback {} -frame something -geometry 20x10
inherits
object configure
config
object empty
object size
object isempty
object get
index
object setf
index line
object save
fileName
object add
text hidden
object select
object remove
index
#@package: listboxes Listbox ToplevelListbox DatabaseListbox DatabaseSearchListbox # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # Handy Little Listbox Class # # Copyright (C) 1996 NeoSoft, All Rights Reserved # # This defines a listbox class which has methods to add # to a listbox and run callbacks when items are selected. # # Most nice about it is that it can keep some data in # parallel to the listbox but squirreled away, not # in the box itself. This way nasty-but-essential things # like indexes and pointers and stuff can be kept out # of sight. # # $Id # # # Set up a window that has a listbox in it, # with a couple of useful buttons. # # Listbox listboxname -frame framename [-title title] # [-callback callback_routine] [-indexCallback index_callback_routine] # [-saveCallback save_callback] [-geometry nxm] # constructor {config} { set w $frame if {$saveCallback != ""} { frame $w.saveframe pack $w.saveframe -fill x button $w.saveframe.savebutton -text "Save" -command $saveCallback pack $w.saveframe.savebutton -side left } set boxframe $w.boxframe frame $boxframe set box $boxframe.box scrollbar $boxframe.bar -relief sunken -command "$box yview" listbox $box -yscroll "$boxframe.bar set" -relief sunken -setgrid 1 -geometry $geometry pack $boxframe.bar -side right -fill y pack $box -side left -expand yes -fill both pack $boxframe -side top -expand yes -fill both bind $box <Double-1> "$this select" } destructor { catch {destroy $w} } method configure {config} { } # # empty out the listbox by deleting all the lines in it # method empty {} { $box delete 0 end } # # return the number of lines in the listbox # method size {} { return [$box size] } # # return 1 if the listbox is empty, else 0 # method isempty {} { return [expr [size] == 0] } # # return a line within the listbox by index # method get {index} { return [$box get $index] } # # set a line in the listbox # method setf {index line} { $box insert $index $line $box delete [expr $index + 1] return } # # save contents of listbox to a file # method save {fileName} { set fp [::open $fileName w] set size [size] for {set i 0} {$i < $size} {incr i} { puts $fp [get $i] } ::close $fp } # # Method to add an entry to the listbox. # # Arguments are the text to go into the listbox, and the # data associated with the text that isn't to be displayed, # i.e. a byte offset or something like that. # method add {text hidden} { set hiddenData([size]) $hidden $box insert end $text } # # Method to perform callbacks on all the selected items. # method select {} { if {$callback != ""} { foreach index [$box curselection] { set text [get $index] eval $callback [list $text] [list $hiddenData($index)] } } if {$indexCallback != ""} { foreach index [$box curselection] { eval $indexCallback $index } } } # # remove an item from the box, by index. # method remove {index} { $box delete $index } protected box protected hiddenData protected w public title public callback "" public indexCallback "" public saveCallback "" public frame public geometry "20x10"
Notepad - an [incr tcl] class
Notepad object -w something -currentFileName something
inherits TextClass
object append_file
fileName
object save_file
fileName
object add_menus
#@package: notepad Notepad # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # Notepad class # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # inherit TextClass constructor {config} { notepad } proc load_file {fileName} { wm title $w "NeoSoft Notepad - $fileName" empty_out_text load $fileName set currentFileName $fileName } method append_file {fileName} { if {[catch {set textFp [open $fileName]} result] == 1} { return } $widgetName insert 1.0 [read $textFp] close $textFp } method save_file {fileName} { set textfp [open $fileName w] puts $textfp [$textWidget get 1.0 end] nonewline close $textfp } method add_menus {} { frame $w.menuFrame pack $w.menuFrame -side top -fill both create_pulldown_menu $w file File 0 add_pulldown command $w file About -command "about_neosoft {NeoSoft Notepad} 1992-1996" -underline 0 add_pulldown command $w file New -underline 0 add_pulldown command $w file Open -command load_button -underline 0 add_pulldown command $w file Save -underline 0 -command save_button add_pulldown command $w file "Save As..." -underline 5 -command save_as_button add_pulldown command $w file Exit -command exit_notepad -underline 0 bind_pulldown_menus $w } proc save_as_button {} { fileselect save_this_file "Save notepad as..." } proc save_button {} { global currentFileName save_text_widget $w.t $currentFileName } proc save_this_file {frame fileName} { destroy $frame save_text_widget $w.t [file root $fileName] } proc load_button {} { fileselect load_this_file "Load notepad..." } proc empty_out_text {w} { $w delete 1.0 end } proc notepad {{topnote .notepad}} { set w $topnote catch {destroy $w} toplevel $w set neoFrame $w.neoFrame frame $neoFrame label $neoFrame.label -bitmap @/usr/neosoft/icons/neosoft.xbm -foreground blue4 pack $neoFrame.label -side left label $neoFrame.idlabel -text "Notepad" pack $neoFrame.idlabel -side left pack $neoFrame -side top -fill both add_menus frame $w.titlebar -relief raised wm title $w "NeoSoft Notepad" wm iconname $w "Notepad" # define the text widget text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true -width 70 -height 28 -wrap word -exportselection true set textWidget $w.t scrollbar $w.s -relief flat -command "$w.t yview" pack $w.s -side right -fill y pack $w.t -expand 1 -fill both # Set up display styles $w.t mark set insert 0.0 bind $w <Any-Enter> "focus $w.t" } proc exit_notepad {} { destroy . } public w public currentFileName
PasswordBox - an [incr tcl] class
PasswordBox object -password {} -widgetName .password
inherits
object insert_char
char key
object delete_char
object run
config
object configure
config
#@package: PasswordBox PasswordBox # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # This file defines a PasswordBox class which will create a password # widget that types asterisks into the entry widget as the user types keys, # rather than the keys the user typed. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # method insert_char {char key} { if {$char == ""} return append password $char $widgetName.password insert end "*" } method delete_char {} { if {$password == ""} return set length [clength $password] if {$length == 0} return if {$length == 1} { set password "" $widgetName.password delete 0 end return } set password [crange $password 0 {[clength $password] - 2}] $widgetName.password delete 0 } method run {config} { set password "" catch {destroy $widgetName} toplevel $widgetName wm minsize $widgetName 1 1 wm title $widgetName "Password Entry" label $widgetName.label -text "Enter Password:" pack $widgetName.label entry $widgetName.password -relief raised pack $widgetName.password focus $widgetName.password bind $widgetName.password <Key> "$this insert_char %A %K" bind $widgetName.password"$this delete_char" bind $widgetName.password "$this delete_char" bind $widgetName.password "destroy $widgetName" center_window $widgetName tkwait window $widgetName return $password } method configure {config} { } public password "" public widgetName ".password"
TextClass - an [incr tcl] class
TextClass object -textWidget something
inherits
object adjust_insert
position
object up
lines 1
object down
lines 1
object left
chars 1
object right
chars 1
object home
object end
object add_bindings
#@package: textclass TextClass # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # incr tcl class for manipulating text widgets # constructor {config} { add_bindings } destructor {} method adjust_insert {position} { $textWidget mark set insert $position $textWidget yview -pickplace insert } method up {{lines 1}} { adjust_insert "insert - $lines line" } method down {{lines 1}} { adjust_insert "insert + $lines line" } method left {{chars 1}} { adjust_insert "insert - $chars chars" } method right {{chars 1}} { adjust_insert "insert + $chars chars" } method home {} { adjust_insert 1.0 } method end {} {adjust_insert end} method add_bindings {} { bind $textWidget <Up> "$this up" bind $textWidget"$this down" bind $textWidget "$this left" bind $textWidget "$this right" bind $textWidget "$this home" bind $textWidget "$this end" } public textWidget
Thermometer - an [incr tcl] class
Thermometer object -scaleWindow something -text {Percent Complete}
inherits
object configure
config
object create
scaleWindowArg
object setf
percent
object ratio
howfar total
object text
string
#@package: Thermometer Thermometer # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # This file defines a Thermometer class, which can be used to graphically # show the progress of the loading of a file, etc. # # In its main function, it can take either a percent complete, or two number # which represent a ratio of how far done the activity is, and it will # adjust its appearance accordingly. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # constructor {config} { } method configure {config} { } method create {scaleWindowArg} { set scaleWindow $scaleWindowArg frame $scaleWindow label $scaleWindow.label -text $text pack $scaleWindow.label frame $scaleWindow.progress pack $scaleWindow.progress frame $scaleWindow.progress.indicator -geometry 1x20 -relief raised -borderwidth 2 -bg SteelBlue1 pack $scaleWindow.progress.indicator -expand yes -anchor sw frame $scaleWindow.progress.distance -geometry 201x5 -relief flat -bg black pack $scaleWindow.progress.distance -anchor sw } method setf {percent} { if {$percent == $previousPercent} return set previousPercent $percent $scaleWindow.progress.indicator configure -geometry [expr $percent*2+1]x20 update } method ratio {howfar total} { setf [expr int($howfar * 100.0 / $total)] } method text {string} { $scaleWindow.label configure -text $string } protected previousPercent -1 public scaleWindow public text "Percent Complete"
ToplevelListbox - an [incr tcl] class
ToplevelListbox object -windowName .toplevel_listbox -dismissCommand delete
inherits Listbox
object build_display
config
object dismiss
object hide
object unhide
# # This listbox builds on the previous one... It creates a # listbox in a toplevel window, and adds a "-dismissCommand" that # can be specified to do something special if the window is dismissed. # # In any case the dismiss button is created, if the -dismissCommand # is not specified, it just deletes the window. # inherit Listbox constructor {config} { set w $windowName build_display } destructor { Listbox::destructor catch {destroy $w} } method build_display {config} { catch {destroy $w} toplevel $w wm minsize $w 1 1 frame $w.keys pack $w.keys -fill x button $w.keys.dismiss -text "Dismiss" -command "$this dismiss" pack $w.keys.dismiss -side left set boxframe $w.boxframe frame $boxframe Listbox::constructor -frame $boxframe pack $w.boxframe -side top -expand yes -fill both } method dismiss {} { eval $this $dismissCommand } method hide {} { wm withdraw $w } method unhide {} { wm deiconify $w } protected w public windowName ".toplevel_listbox" public dismissCommand "delete"
about_neosoft
about_neosoft application year
#@package: neologo about_neosoft # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # global NEOSOFT_ENV set w .about_neosoft catch {destroy $w} toplevel $w frame $w.titleFrame -relief raised label $w.titleFrame.neologo -bitmap @$NEOSOFT_ENV(desktopBitmaps)/neologo.medium.xbm label $w.titleFrame.neosoft -bitmap @$NEOSOFT_ENV(desktopBitmaps)/large-neosoft.xbm pack $w.titleFrame.neologo -side left pack $w.titleFrame.neosoft -side left pack $w.titleFrame -side top message $w.message -aspect 500 -text "$application\nCopyright (C) $year NeoSoft. All Rights Reserved" -font "*-medium-o-normal--*-240-*" pack $w.message -side top -fill both frame $w.buttonFrame button $w.buttonFrame.okButton -text "OK" -command "destroy $w" pack $w.buttonFrame.okButton pack $w.buttonFrame -side top -fill both
add_pulldown
add_pulldown command parentFrame menuName entryName args
set menuFrame [combine_widgetnames $parentFrame menuFrame] set menu $menuFrame.$menuName.m eval $menu add $command -label \"$entryName\" $args
add_pulldown_separator
add_pulldown_separator parentFrame menuName
set menuFrame [combine_widgetnames $parentFrame menuFrame] set menu $menuFrame.$menuName.m $menu add separator
bind_pulldown_menus
bind_pulldown_menus parentFrame
global pulldownMenuElements set menuFrame [combine_widgetnames $parentFrame menuFrame] foreach frame [array names pulldownMenuElements] { eval tk_menuBar $frame $pulldownMenuElements($frame) } tk_bindForTraversal $menuFrame bind $parentFrame <Any-Enter> "focus $menuFrame"
center_window
center_window w
#@package: neowindow center_window # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # # Miscellaneous window goodies # # # # Center a window on the screen # # Center the window on the screen. wm withdraw $w update idletasks set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 - [winfo vrootx $w]] set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]] wm geom $w +$x+$y wm deiconify $w
combine_widgetnames
combine_widgetnames parentName childName
#@package: menu1 create_pulldown_menu # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # # first cut at menus, see control station to see it in use # # doesn't do enough, but it at least simplifies things # # if {$parentName == "."} { return .$childName } return $parentName.$childName
create_pulldown_menu
create_pulldown_menu parentFrame menuName menuText underline {packing left}
global pulldownMenuElements set menuFrame [combine_widgetnames $parentFrame menuFrame] set buttonName "$menuFrame.$menuName" menubutton $buttonName -text $menuText -menu $buttonName.m -underline $underline menu $buttonName.m pack append $menuFrame $buttonName $packing lappend pulldownMenuElements($menuFrame) $buttonName
create_scrollable_canvas
create_scrollable_canvas w
#@package: neocanvas create_scrollable_canvas # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. frame $w canvas $w.canvas -yscroll "$w.yscroll set" -xscroll "$w.xscroll set" -width 15c -height 5c -relief sunken scrollbar $w.yscroll -relief sunken -command "$w.canvas yview" scrollbar $w.xscroll -relief sunken -orient horiz -command "$w.canvas xview" pack $w.xscroll -side bottom -fill x pack $w.yscroll -side right -fill y pack $w.canvas -in $w -expand yes -fill both pack $w -side top -expand yes -fill both return $w
fileselect
fileselect {cmd fileselect.default.cmd} {purpose "file:"} {w .file_select}
catch {destroy $w} global FS_cmd FS_w set FS_cmd $cmd set FS_w $w toplevel $w wm title $w "Select File" # path independent names for the widgets global entry FS_list ok cancel dirlabel set entry $w.file.eframe.entry set FS_list $w.file.sframe.list set scroll $w.file.sframe.scroll set ok $w.bframe.okframe.ok set cancel $w.bframe.cancel set dirlabel $w.file.dirlabel # widgets frame $w.file -bd 10 frame $w.bframe -bd 10 pack $w.file -side left -fill y pack $w.bframe -side left -expand yes -anchor n frame $w.file.eframe frame $w.file.sframe label $w.file.dirlabel -width 24 -anchor e -text [exec pwd] pack $w.file.eframe -side top -anchor w pack $w.file.sframe -side top -anchor w pack $w.file.dirlabel -side top -anchor w label $w.file.eframe.label -text "$purpose" entry $w.file.eframe.entry -relief sunken pack $w.file.eframe.label -side top -expand yes -anchor w pack $w.file.eframe.entry -side top -fill x -anchor w scrollbar $w.file.sframe.yscroll -relief sunken -command "$w.file.sframe.list yview" listbox $w.file.sframe.list -relief sunken -geometry "25x10" -yscroll "$w.file.sframe.yscroll set" pack $w.file.sframe.yscroll -side right -fill y pack $w.file.sframe.list -side left # buttons frame $w.bframe.okframe -borderwidth 2 -relief sunken button $w.bframe.okframe.ok -text OK -relief raised -padx 10 -command "ok.cmd;" button $w.bframe.cancel -text cancel -relief raised -padx 10 -command "cancel.cmd; destroy $w" pack $w.bframe.okframe.ok -padx 10 -pady 10 pack $w.bframe.okframe -expand yes -padx 20 -pady 20 pack $w.bframe.cancel -side top # Fill the listbox with a list of all the files in the directory (run # the "ls" command to get that information). foreach i [exec ls -a [exec pwd]] { if {[string compare $i "."] != 0} { $FS_list insert end $i } } # Set up bindings for the browser. bind $entry <Return> {eval $ok invoke} bind $entry{eval $cancel invoke} bind $w {eval $cancel invoke} bind $w {eval $ok invoke} bind $FS_list { # puts stderr "button 1" %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] } bind $FS_list { %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] } bind $FS_list " " bind $FS_list { # puts stderr "double button 1" eval $ok invoke } bind $FS_list { %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] eval $ok invoke } # button procedures proc cancel.cmd {} { puts stderr "Cancel" } proc ok.cmd {} { global entry dirlabel FS_list set selected [$entry get] if {[file isdirectory $selected] != 0} { cd $selected set dir [exec pwd] eval $dirlabel configure -text $dir $FS_list delete 0 end foreach i [exec ls -a $dir] { if {[string compare $i "."] != 0} { eval $FS_list insert end $i } } return } global FS_cmd FS_w eval $FS_cmd $FS_w $selected }
fileselect.default.cmd
fileselect.default.cmd w f
#@package: fileselect fileselect # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # Originally from Mario J. Silva #From: msilva@mercenary.CS.Berkeley.EDU (Mario J. Silva) #Date: 16 Jan 93 15:12:01 #Distribution: world #Message-ID:#References: <1j97ddINN43q@urmel.informatik.rwth-aachen.de> #In-reply-to: kuku@acds.physik.rwth-aachen.de's message of 16 Jan 1993 14:51:25 GMT # #This one mimicks Framemaker's file selector. #Never tried it with tk3.0, but I believe changes will be minimal, if #any. As this is pre-tk3.0, there are no grabs. That should now be #easy. Just add a couple of Tcl/Tk lines at the right place. #Mario Jorge Silva msilva@cs.Berkeley.EDU #University of California Berkeley Ph: +1(510)642-8248 #Computer Science Division, 571 Evans Hall Fax: +1(510)642-5775 #Berkeley CA 94720 # # # file: +----+ # ____________________ | OK | # +----+ # # +------------------+ Cancel # | .. |S # | file1 |c # | file2 |r # | |b # | filen |a # | |r # +------------------+ # currrent-directory # use the option command for further configuration puts stderr "selected file $f" destroy $w
kfileselect
kfileselect {purpose "file:"} {w .file_select}
#@package: kfileselect kfileselect # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # Originally from Mario J. Silva #From: msilva@mercenary.CS.Berkeley.EDU (Mario J. Silva) #Date: 16 Jan 93 15:12:01 #Distribution: world #Message-ID:#References: <1j97ddINN43q@urmel.informatik.rwth-aachen.de> #In-reply-to: kuku@acds.physik.rwth-aachen.de's message of 16 Jan 1993 14:51:25 GMT # #This one mimicks Framemaker's file selector. #Never tried it with tk3.0, but I believe changes will be minimal, if #any. As this is pre-tk3.0, there are no grabs. That should now be #easy. Just add a couple of Tcl/Tk lines at the right place. #Mario Jorge Silva msilva@cs.Berkeley.EDU #University of California Berkeley Ph: +1(510)642-8248 #Computer Science Division, 571 Evans Hall Fax: +1(510)642-5775 #Berkeley CA 94720 # # # file: +----+ # ____________________ | OK | # +----+ # # +------------------+ Cancel # | .. |S # | file1 |c # | file2 |r # | |b # | filen |a # | |r # +------------------+ # currrent-directory # use the option command for further configuration catch {destroy $w} global FS_cmd FS_w set FS_cmd "" set FS_w $w toplevel $w wm title $w "Select File" wm minsize $w 1 1 # path independent names for the widgets global entry FS_list ok cancel dirlabel set entry $w.file.eframe.entry set FS_list $w.file.sframe.list set scroll $w.file.sframe.scroll set ok $w.bframe.okframe.ok set cancel $w.bframe.cancel set dirlabel $w.file.dirlabel # widgets frame $w.file -bd 10 frame $w.bframe -bd 10 pack $w.file -side left -fill both -expand yes pack $w.bframe -side left -anchor n frame $w.file.eframe frame $w.file.sframe label $w.file.dirlabel -anchor w -text [pwd] pack $w.file.eframe -side top -anchor w -fill x pack $w.file.sframe -side top -anchor w -expand yes -fill both pack $w.file.dirlabel -side top -anchor w -fill x label $w.file.eframe.label -text "$purpose" entry $w.file.eframe.entry -relief sunken pack $w.file.eframe.label -side top -anchor w -fill x pack $w.file.eframe.entry -side top -fill x -anchor w scrollbar $w.file.sframe.yscroll -relief sunken -command "$w.file.sframe.list yview" listbox $w.file.sframe.list -relief sunken -geometry "25x10" -yscroll "$w.file.sframe.yscroll set" pack $w.file.sframe.yscroll -side right -fill y pack $w.file.sframe.list -side left -fill both -expand yes # buttons frame $w.bframe.okframe -borderwidth 2 -relief sunken button $w.bframe.okframe.ok -text OK -relief raised -padx 10 -command "ok.cmd" button $w.bframe.cancel -text cancel -relief raised -padx 10 -command "cancel.cmd" pack $w.bframe.okframe.ok -padx 10 -pady 10 pack $w.bframe.okframe -padx 20 -pady 20 pack $w.bframe.cancel -side top # Fill the listbox with a list of all the files in the directory (run # the "ls" command to get that information). foreach i [lsort [glob .* *]] { if {$i != "."} { $FS_list insert end $i } } # Set up bindings for the browser. bind $entry <Return> {eval $ok invoke} bind $entry {eval $cancel invoke} bind $w {eval $cancel invoke} bind $w {eval $ok invoke} bind $FS_list { # puts stderr "button 1" %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] } bind $FS_list { %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] } bind $FS_list " " bind $FS_list { # puts stderr "double button 1" eval $ok invoke } bind $FS_list { %W select from [%W nearest %y] %W select to [%W nearest %y] eval $entry delete 0 end eval $entry insert 0 [%W get [%W nearest %y]] eval $ok invoke } # button procedures proc cancel.cmd {} { global FS_cmd FS_w set FS_cmd "" destroy $FS_w } proc ok.cmd {} { global entry dirlabel FS_list set selected [$entry get] if {[file isdirectory $selected] != 0} { cd $selected set dir [pwd] eval $dirlabel configure -text $dir $FS_list delete 0 end foreach i [lsort [glob $dir/.* $dir/*]] { if {[string compare $i "."] != 0} { eval $FS_list insert end $i } } return } global FS_cmd FS_w set FS_cmd $selected destroy $FS_w } tkwait window $w return $FS_cmd
list_listbox_subwindow
list_listbox_subwindow w label geometry list
#@package: boxwindow list_listbox_subwindow # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # # # set result [list_listbox_subwindow .windowname "Show this text" $list] # # Does a listbox thing with scroll bars where each entry is an element in # the passed list. Clicking cancel causes it to # return empty, clicking OK or double clicking an entry returns the # name of the corresponding array element. # # If more than one entry is selected, only the first one is returned. # upvar #0 result_$w result catch {destroy $w} toplevel $w label $w.label -text $label pack $w.label -side top frame $w.frame pack $w.frame -side top scrollbar $w.frame.yscroll -relief sunken -command "$w.frame.list yview" pack $w.frame.yscroll -side right -fill y scrollbar $w.frame.xscroll -relief sunken -orient horizontal -command "$w.frame.list xview" pack $w.frame.xscroll -side bottom -fill x listbox $w.frame.list -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set" -geometry $geometry -relief sunken pack $w.frame.list -side top bind $w.frame.list <Double-1> "list_subwindow_ok $w" foreach element $list { $w.frame.list insert end $element } frame $w.buttons button $w.buttons.ok -text OK -command "list_subwindow_ok $w" button $w.buttons.cancel -text Cancel -command "list_subwindow_cancel $w" pack $w.buttons.ok -side left -fill x pack $w.buttons.cancel -side left -fill x pack $w.buttons -side top tkwait window $w return $result
list_subwindow_cancel
list_subwindow_cancel w
upvar #0 result_$w result set result "" destroy $w
list_subwindow_ok
list_subwindow_ok w
upvar #0 result_$w result set result [$w.frame.list get [lindex [$w.frame.list curselection] 0]] destroy $w
modal_dialog
modal_dialog msgArgs args
#@package: modal_dialog modal_dialog # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # modal_dialog msgArgs list list ... # # Create a modal dialog box with a message and any number of buttons at # the bottom. # # Arguments: # msgArgs - List of arguments to use when creating the message of the # dialog box (e.g. text, justifcation, etc.) # # list - A two-element list that describes one of the buttons that # will appear at the bottom of the dialog. The first element # gives the text to be displayed in the button and the second # gives the value to be returned when the button is invoked. # If the second element doesn't exist, the first is returned. # #modal_dialog {-text {Modal dialog.} -aspect 250 -justify left} {OK ok} {Cancel slag_off} # global modalDialogResult set w ".modal_dialog" catch {destroy $w} toplevel $w -class Dialog wm minsize $w 1 1 wm title $w "Dialog box" wm iconname $w "Dialog" # Create two frames in the main window. The top frame will hold the # message and the bottom one will hold the buttons. Arrange them # one above the other, with any extra vertical space split between # them. frame $w.top -relief raised -border 1 frame $w.bot -relief raised -border 1 pack $w.top -side top -fill both -expand yes pack $w.bot -side top -fill both -expand yes # Create the message widget and arrange for it to be centered in the # top frame. eval message $w.top.msg -justify center -font -Adobe-times-medium-r-normal--*-180* $msgArgs pack $w.top.msg -side top -expand yes -padx 5 -pady 5 # Create as many buttons as needed and arrange them from left to right # in the bottom frame. Embed the left button in an additional sunken # frame to indicate that it is the default button, and arrange for that # button to be invoked as the default action for clicks and returns in # the dialog. if {[llength $args] > 0} { set arg [lindex $args 0] set resultText [lindex $arg 1] if {$resultText == ""} { set resultText [lindex $arg 0] } frame $w.bot.0 -relief sunken -border 1 pack $w.bot.0 -side left -expand yes -padx 20 -pady 20 button $w.bot.0.button -text [lindex $arg 0] -command "destroy $w; set modalDialogResult \"$resultText\"" pack $w.bot.0.button -expand yes -padx 12 -pady 12 bind $w <Return> "destroy $w; set modalDialogResult \"$resultText\"" focus $w set i 1 foreach arg [lrange $args 1 end] { set resultText [lindex $arg 1] if {$resultText == ""} { set resultText [lindex $arg 0] } button $w.bot.$i -text [lindex $arg 0] -command "destroy $w; set modalDialogResult \"$resultText\"" pack $w.bot.$i -side left -expand yes -padx 20 set i [expr $i+1] } } bind $w[list focus $w] bind $w "grab $w; focus $w" center_window $w tkwait window $w return $modalDialogResult
modal_dialog_bitmap
modal_dialog_bitmap bitmap msgArgs args
#@package: modal_dialog2 modal_dialog_bitmap # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # # modal_dialog msgArgs list list ... # # Create a modal dialog box with a message and any number of buttons at # the bottom. # # Arguments: # msgArgs - List of arguments to use when creating the message of the # dialog box (e.g. text, justifcation, etc.) # # list - A two-element list that describes one of the buttons that # will appear at the bottom of the dialog. The first element # gives the text to be displayed in the button and the second # gives the value to be returned when the button is invoked. # If the second element doesn't exist, the first is returned. # #modal_dialog_bitmap @~/icons/skull.xbm {-text {Modal dialog.} -aspect 250 -justify left} {OK ok} {Cancel slag_off} # global modalDialogResult set w ".modal_dialog" catch {destroy $w} toplevel $w -class Dialog wm minsize $w 1 1 wm title $w "Dialog box" wm iconname $w "Dialog" # Create two frames in the main window. The top frame will hold the # message and the bottom one will hold the buttons. Arrange them # one above the other, with any extra vertical space split between # them. frame $w.top -relief raised -border 1 frame $w.bot -relief raised -border 1 pack $w.top -side top -fill both -expand yes pack $w.bot -side top -fill both -expand yes # Create the message widget and arrange for it to be centered in the # top frame. label $w.top.label -bitmap $bitmap pack $w.top.label -side left -expand yes -padx 5 -pady 5 eval message $w.top.msg -justify center -font -Adobe-times-medium-r-normal--*-180* $msgArgs pack $w.top.msg -side left -expand yes -padx 5 -pady 5 # Create as many buttons as needed and arrange them from left to right # in the bottom frame. Embed the left button in an additional sunken # frame to indicate that it is the default button, and arrange for that # button to be invoked as the default action for clicks and returns in # the dialog. if {[llength $args] > 0} { set arg [lindex $args 0] set resultText [lindex $arg 1] if {$resultText == ""} { set resultText [lindex $arg 0] } frame $w.bot.0 -relief sunken -border 1 pack $w.bot.0 -side left -expand yes -padx 20 -pady 20 button $w.bot.0.button -text [lindex $arg 0] -command "destroy $w; set modalDialogResult \"$resultText\"" pack $w.bot.0.button -expand yes -padx 12 -pady 12 bind $w <Return> "destroy $w; set modalDialogResult \"$resultText\"" focus $w set i 1 foreach arg [lrange $args 1 end] { set resultText [lindex $arg 1] if {$resultText == ""} { set resultText [lindex $arg 0] } button $w.bot.$i -text [lindex $arg 0] -command "destroy $w; set modalDialogResult \"$resultText\"" pack $w.bot.$i -side left -expand yes -padx 20 set i [expr $i+1] } } bind $w[list focus $w] bind $w "grab $w; focus $w" center_window $w tkwait window $w return $modalDialogResult
neosoft:font1:crack_fonts
neosoft:font1:crack_fonts
# additional fields in assign_fields would be # pointSize xResolution yResolution spacing averageWidth # registry encoding global fontPoints fontInfo for_file line "|xlsfonts" { assign_fields [split $line "-"] dummy foundry family weight slant width style pixelSize if [info exists fontPoints($family)] { if {[lsearch $fontPoints($family) $pixelSize] < 0} { lappend fontPoints($family) $pixelSize } } else { set fontPoints($family) $pixelSize } lappend fontInfo($family:$pixelSize) [list $foundry $weight $slant $width] }
neosoft:font1:create_font_selector
neosoft:font1:create_font_selector w
global fontPoints fontInfo global NEOSOFT_ENV set dropBitmap $NEOSOFT_ENV(desktopBitmaps)/standard/Down frame $w label $w.name_label -text "Font" entry $w.font_name -relief raised -width 20 button $w.drop_font_button -bitmap @$dropBitmap -command "neosoft:font1:drop_fontlist $w" pack $w.name_label -side left pack $w.font_name -side left pack $w.drop_font_button -side left label $w.size_label -text "Size" entry $w.font_size -relief raised -width 3 button $w.drop_size_button -bitmap @$dropBitmap -command "neosoft:font1:drop_fontsizelist $w" pack $w.size_label -side left pack $w.font_size -side left pack $w.drop_size_button -side left label $w.info_label -text "Characteristics" entry $w.font_info -relief raised -width 30 button $w.drop_info_button -bitmap @$dropBitmap -command "neosoft:font1:drop_fontinfolist $w" pack $w.info_label -side left pack $w.font_info -side left pack $w.drop_info_button -side left neosoft:font1:set_font_defaults $w return $w
neosoft:font1:create_font_tag
neosoft:font1:create_font_tag w textWidget
set tagName [neosoft:font1:get_current_font_string $w] $textWidget tag configure $tagName -font $tagName return $tagName
neosoft:font1:drop_fontinfolist
neosoft:font1:drop_fontinfolist w
global fontInfo fontPoints set fontName [$w.font_name get] if ![info exists fontPoints($fontName)] { modal_dialog "I know of no font named '$fontName'" Cancel return } set pixelSize [$w.font_size get] set indexName $fontName:$pixelSize if ![info exists fontInfo($indexName)] { modal_dialog "I have no font named '$fontName' at a pixel size of '$pixelSize'." Cancel return } set pointInfoList $fontInfo($indexName) set pointInfo [list_listbox_subwindow .fontlist "Please select font characteristics." 35x4 [lsort $pointInfoList]] $w.font_info delete 0 end $w.font_info insert 0 $pointInfo
neosoft:font1:drop_fontlist
neosoft:font1:drop_fontlist w
global fontPoints set font [list_listbox_subwindow .fontlist "Please pick a font." 20x10 [lsort [array names fontPoints]]] $w.font_name delete 0 end $w.font_name insert 0 $font
neosoft:font1:drop_fontsizelist
neosoft:font1:drop_fontsizelist w
global fontPoints set fontName [$w.font_name get] if ![info exists fontPoints($fontName)] { modal_dialog "I know of no font named '$fontName'" Cancel return } set pixelSizeList $fontPoints($fontName) set pixelSize [list_listbox_subwindow .fontlist "Please pick a point size." 5x5 [lsort $pixelSizeList]] $w.font_size delete 0 end $w.font_size insert 0 $pixelSize
neosoft:font1:dump_fonts
neosoft:font1:dump_fonts
global fontPoints fontInfo foreach family [array names fontPoints] { set points [lsort $fontPoints($family)] echo '$family' $points foreach size $points { echo " $fontInfo($family:$size)" } }
neosoft:font1:get_current_font_string
neosoft:font1:get_current_font_string w
set fontName [$w.font_name get] set pixelSize [$w.font_size get] assign_fields [$w.font_info get] foundry weight slant width return [join [list "" $foundry $fontName $weight $slant $width "" $pixelSize *] "-"]
neosoft:font1:set_font_defaults
neosoft:font1:set_font_defaults w
#@package: neosoft:font1 neosoft:font1:create_font_selector neosoft:font1:crack_fonts # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ # #font family # point size # family # weight # slant # width # style $w.font_name delete 0 end $w.font_name insert end "new century schoolbook" $w.font_size delete 0 end $w.font_size insert end 10 $w.font_info delete 0 end $w.font_info insert end "adobe medium i normal"
neosoft_init
neosoft_init
#@package: neosoft_init neosoft_init # # Copyright (C) 1992-1996 NeoSoft. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. NeoSoft makes no # representations about the suitability of this software for any purpose. # It is provided "as is" without express or implied warranty. # # $Id: neo_tklib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $ #