help.tcl

TKCVS Source Code For CVS。

#
# Tcl Library for TkCVS
#

# Help procedures and help data.
#
#########################################
#
# Developers: Please don't majorly change the formatting of this
# file unless you know what you're doing.
# The script "mkmanpage.pl" builds a manpage out of it, and the
# thing is the product of an unbelievable number of hours spent
# tweaking this file and the script so that both the help and
# the manpage look sort of OK.
#
# If you do add something to this, do "mkmanpage.pl > tkcvs.n"
# to keep the manpage in sync, then look at it to make sure
# it worked.
#
# - dorothy
#########################################

proc aboutbox {} {
  global cvscfg

  toplevel .about
  wm title .about "About TkCVS!"

  frame .about.top

  message .about.top.msg1 -width 400 -justify c \
    -text "\nTkCVS Version 8.0.3\n" -font $cvscfg(guifont)
  pack .about.top -side top -expand 1 -fill both

  image create photo Tclfish -format gif -file \
    [file join $cvscfg(bitmapdir) ticklefish_med.gif]
  label .about.top.gif1 -image Tclfish
  image create photo Anglerfish -format gif -file \
    [file join $cvscfg(bitmapdir) anglerfish_med.gif]
  label .about.top.gif2 -image Anglerfish

  append string1 "A friendly interface to CVS\n"
  append string1 " * and Subversion *\n"

  message .about.top.msg2 -width 400 -justify c \
    -text $string1

  append string2 "\nConsult the Help menu to\n"
  append string2 "learn about its features.\n\n"
  append string2 "TkCVS was written by Del.\n"
  append string2 "The Subversion functionality\n"
  append string2 "was added by Dorothy.\n"

  message .about.top.msg3 -width 400 -justify c \
    -text $string2

  append about_string "Home page: http://www.twobarleycorns.net/tkcvs.html\n"
  append about_string "Source code: http://sourceforge.net/projects/tkcvs/\n"

  message .about.top.msg4 -width 365 -justify c \
    -text $about_string -font $cvscfg(listboxfont)

  pack .about.top -side top -expand 1 -fill both
  pack .about.top.msg1 -expand 1 -fill x
  pack .about.top.gif1
  pack .about.top.msg2 -expand 1 -fill x
  pack .about.top.gif2
  pack .about.top.msg3 -expand 1 -fill x
  pack .about.top.msg4 -expand 1 -fill x

  frame .about.down
  button .about.down.ok -text "OK" -command {destroy .about}

  pack .about.down -side bottom -expand 1 -fill x -pady 2
  pack .about.down.ok
}

proc cvs_version {} {
#
# This shows CVS banner.
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER"
  set v [viewer::new "Versions"]

  $v\::log "\n-----------------------------------------"
  set commandline "$cvs -v"
  set ret [catch {eval "exec $commandline"} output]
  $v\::log $output

  $v\::log "\n-----------------------------------------\n"
  set commandline "svn --version"
  set ret [catch {eval "exec $commandline"} output]
  $v\::log $output

  $v\::log "\n-----------------------------------------\n"
  set commandline "rcs -V"
  set ret [catch {eval "exec $commandline"} output]
  $v\::log $output
  if {$ret != 0} {
    $v\::log "\nIf you see a usage message here, you have"
    $v\::log " an old version of RCS.  It should still work.\n"
  }

  gen_log:log T "LEAVE"
}

proc wish_version {{parent {.}}} {
  global tk_version

  set version $tk_version
  set whichwish [info nameofexecutable]

  set about_string "$whichwish\n\n"
  append about_string "Tk version  $version"

  tk_messageBox -title "About Wish" \
    -message $about_string \
    -parent $parent \
    -type ok
}

######################################################################
#
# text formatting routines derived from Klondike
# Reproduced here with permission from their author.
#
# Copyright (C) 1993,1994 by John Heidemann <[e-mail]>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of John Heidemann may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY JOHN HEIDEMANN ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL JOHN HEIDEMANN BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
######################################################################

proc put-text {tw txt} {

    gen_log:log T "ENTER ($tw ...)"
    $tw configure -font -*-Times-Medium-R-Normal-*-14-*

    $tw tag configure bld -font -*-Times-Bold-R-Normal-*-14-*
    $tw tag configure cmp -font -*-Courier-Medium-R-Normal-*-12-*
    $tw tag configure h1 -font -*-Helvetica-Bold-R-Normal-*-18-* -underline 1
    $tw tag configure h2 -font -*-Helvetica-Bold-R-Normal-*-18-*
    $tw tag configure h3 -font -*-Helvetica-Bold-R-Normal-*-14-*
    $tw tag configure itl -font -*-Times-Medium-I-Normal-*-14-*
    $tw tag configure rev -foreground white -background black

    $tw tag configure btn \
            -font -*-Courier-Medium-R-Normal-*-12-* \
            -foreground black -background white \
            -relief groove -borderwidth 2

    $tw mark set insert 0.0

    set t $txt

    while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} {

        set start [lindex $inds 0]
        set end [lindex $inds 1]
        set keyword [string range $t $start $end]

        set oldend [$tw index end]

        $tw insert end [string range $t 0 [expr {$start - 2}]]

        purge-all-tags $tw $oldend insert

        if {[string range $keyword 0 0] == "/"} {
            set keyword [string trimleft $keyword "/"]
            if {[info exists tags($keyword)] == 0} {
                error "end tag $keyword without beginning"
            }
            #gen_log:log D "$tw tag add $keyword $tags($keyword) insert"
            $tw tag add $keyword $tags($keyword) insert
            unset tags($keyword)
        } else {
            if {[info exists tags($keyword)] == 1} {
                error "nesting of begin tag $keyword"
            }
            set tags($keyword) [$tw index insert]
        }

        set t [string range $t [expr {$end + 2}] end]
    }

    set oldend [$tw index end]
    $tw insert end $t
    purge-all-tags $tw $oldend insert
    gen_log:log T "LEAVE"
}

proc purge-all-tags {w start end} {
    foreach tag [$w tag names $start] {
        $w tag remove $tag $start $end
    }
}

######################################################################
#
# End of text formatting routines.
#
######################################################################

proc do_help {title helptext} {
  global cvscfg
  global tcl_platform

  gen_log:log T "ENTER $title <helptext suppressed>)"
  static {helpviewer 0}

  incr helpviewer
  set cvshelpview ".cvshelpview$helpviewer"
  toplevel $cvshelpview
  text $cvshelpview.text -setgrid yes -wrap word \
    -width 55 -relief sunken -border 2 \
    -yscroll "$cvshelpview.scroll set"
  scrollbar $cvshelpview.scroll -relief sunken \
    -command "$cvshelpview.text yview"
  button $cvshelpview.close -text "Close" \
    -command "destroy $cvshelpview; exit_cleanup 0"

  pack $cvshelpview.close -side bottom