# jabout.tcl - procedures for providing `about' boxes
#
###############################################################################
#  Copyright 1992-2001 by Jay Sekora.  This file may be freely distributed,   #
#  modified or unmodified, for any purpose, provided that this copyright      #
#  notice is retained verbatim in all copies and no attempt is made to        #
#  obscure the authorship of this file.  If you distribute any modified       #
#  versions, I ask, but do not require, that you clearly mark any changes     #
#  you make as such and that you provide your users with instructions for     #
#  getting the original sources.                                              #
###############################################################################

# THIS IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require aq
  namespace eval ::aq { }			;# so namespace is defined
}

######################################################################
# j:about name richtext - create an about box containing richtext
######################################################################

proc j:about { name args } {
  ::aq::parse_args {
    {title "About"}
  }
  
  set w $name				;# name of toplevel
  set richtext [lindex $args 0]
  
  set old_focus [focus]			;# so we can restore original focus
  
  if {[winfo exists $w]} {destroy $w}
  toplevel $w
  wm title $w $title
  
  text $w.t -width 65 -height 15 -borderwidth 20 -relief flat
  j:rt text $w.t
  eval $richtext
  j:rt:done
  
  frame $w.b
  button $w.b.ok -text OK -width 8 -command "
    focus -force $old_focus		;# can't figure out a better way...
    destroy $w
  "
  frame $w.b.ok-border -relief sunken -borderwidth 1
  raise $w.b.ok
  pack $w.b.ok -in $w.b.ok-border -padx 2 -pady 2

  pack [::aq::filler $w.b] -in $w.b -side left
  pack [::aq::filler $w.b] -in $w.b -side right
    
  pack $w.b.ok-border -side right -pady 10
  pack $w.t -in $w -side top -fill both
  pack [::aq::rule $w -width 200] -in $w -side top -fill x
  pack $w.b -in $w -side top -fill x
  
  ::aq::dialogue $w		;# position in centre of screen

  focus $w
  bind $w <Key-Return> "$w.b.ok invoke"
}

######################################################################
# j:about:button aboutbox label richtext - add a button to an about box
######################################################################

proc j:about:button { aboutbox label richtext } {
  set label $label
  
  global j:about:button:count
    if {[info exists j:about:button:count]} then {
    set j:about:button:count [expr {${j:about:button:count} + 1}]
  } else {
    set j:about:button:count 0
  }

  set parent $aboutbox.b	;# name of frame with buttons
  set button $parent.${j:about:button:count}
  set border $button-border

  set min_width [expr {[string length $label] + 2}]
  set width [expr {$min_width > 8 ? $min_width : 8}]
  
  button $button -text $label -width $width \
    -command "j:rt text $aboutbox.t; $richtext; j:rt:done"
  frame $border
  raise $button
  pack $button -in $border -padx 2 -pady 2
  pack [::aq::filler $parent] $border -in $parent -side right
}

######################################################################
# j:about_jay - talk about myself
######################################################################

proc j:about_jay {} {
  return [= about:about_jay {
    j:rt:hl "Jay Sekora"
    j:rt:cr
    j:rt:tt "js@aq.org"
    j:rt:cr
    j:rt:rm "URL "
    j:rt:tt "http://www.aq.org/~js/"
    j:rt:par
    j:rt:rm "I'm a Unix systems administrator in Boston, Massachusetts."
    j:rt:par
    j:rt:rm "I was a linguistics major in college.  "
    j:rt:rm "I like spicy food, Celtic folk music, bad puns, New England "
    j:rt:rm "contra dancing, and "
    j:rt:it "Winnie the Pooh."
  }]
}

######################################################################
# j:about_tktcl - describe tk and tcl
######################################################################

proc j:about_tktcl {} {
  return [= about:about_tktcl {
    j:rt:hl "Tk and Tcl"
    j:rt:par
    j:rt:rm "This application is written in "
    j:rt:tt "wish"
    j:rt:rm ", a scripting shell for X Windows applications based on the "
    j:rt:rm "Tk toolkit, which in turn is based on the Tcl"
    j:rt:rm " language and scripting library, all amazingly useful tools "
    j:rt:rm "by John Ousterhout."
    j:rt:par
    j:rt:rm "The Internet newsgroup "
    j:rt:tt "comp.lang.tcl"
    j:rt:rm " is devoted to Tcl and related tools, and a Tcl/Tk FAQ "
    j:rt:rm "(`Frequently Asked Questions') is periodically posted.  "
    j:rt:rm "More information about Tcl is at "
    j:rt:tt "http://www.tcltk.com/"
    j:rt:rm ", and the FAQ and an archive are at "
    j:rt:tt "http://www.neosoft.com/tcl/"
    j:rt:rm "."
  }]
}
