Tcl Source Code

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

proc findversion {top name useversion} {
    set upper [string toupper $name]
    foreach top1 [list $top $top/..] sub {{} generic} {
	foreach dirname [
	    glob -nocomplain -tails -type d -directory $top1 *] {

	    set tclh [join [list $top1 $dirname {*}$sub $name.h] /]
	    if {[file exists $tclh]} {
		set chan [open $tclh]
		set data [read $chan]
		close $chan
		# backslash isn't required in front of quote, but it keeps syntax
		# highlighting straight in some editors
		if {[regexp -lineanchor \
		    [string map [list @name@ $upper] \
			{^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
		    $data -> major minor]} {
			# to do
			#     use glob matching instead of string matching or add
			#     brace handling to [string matcch]
			if {$useversion eq {} || [string match $useversion $major.$minor]} {
			    set top [file dirname [file dirname $tclh]]
			    set prefix [file dirname $top]
			    return [list $prefix [file tail $top] $major $minor]
			}
		}
	    }
	}
    }
    return
}

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
    global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose

    # Set defaults based on original code.
    set tcltkdir ../..
    set tkdir {}
    set tcldir {}
    set webdir ../html
    set build_tcl 0
    set opt_build_tcl 0
    set build_tk 0
    set opt_build_tk 0
    set verbose 0
    # Default search version is a glob pattern
    set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}

    # Handle arguments a la GNU:
    #   --version
    #   --useversion=<version>

	    --useversion=* {
		# length of "--useversion=" is 13
		set useversion [string range $option 13 end]
	    }

	    --tcl {
		set build_tcl 1
		set opt_build_tcl 1
	    }

	    --tk {
		set build_tk 1
		set opt_build_tk 1
	    }

	    --verbose=* {
		set verbose [string range $option \
				 [string length --verbose=] end]
	    }
	    default {
		puts stderr "tcltk-man-html: unrecognized option -- `$option'"
		exit 1
	    }
	}
    }

    if {!$build_tcl && !$build_tk} {
	set build_tcl 1;
	set build_tk 1
    }

    if {$build_tcl} {
	# Find Tcl.

	lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
	if {$tcldir eq {} && $opt_build_tcl} {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcltkdir $tcldir"
    }


    if {$build_tk} {
	# Find Tk.

	lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor
	if {$tkdir eq {} && $opt_build_tk} {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {
	append overall_title "Tcl $major.$minor"
    }
    if {$build_tcl && $build_tk} {
	append overall_title "/"
    }
    if {$build_tk} {
	append overall_title "[capitalize $tkdir]"
    }