doctools.tcl

Go to the documentation of this file.

/*  doctools.tcl --*/
/* */
/*  Implementation of doctools objects for Tcl.*/
/* */
/*  Copyright (c) 2003-2007 Andreas Kupries <andreas_kupries@sourceforge.net>*/
/* */
/*  See the file "license.terms" for information on usage and redistribution*/
/*  of this file, and for a DISCLAIMER OF ALL WARRANTIES.*/
/*  */
/*  RCS: @(#) $Id: doctools.tcl,v 1.22 2007/08/20 20:11:59 andreas_kupries Exp $*/

package require Tcl 8.2
package require textutil::expander

/*  @mdgen OWNER: api.tcl*/
/*  @mdgen OWNER: checker.tcl*/
/*  @mdgen OWNER: mpformats/*.tcl*/
/*  @mdgen OWNER: mpformats/*.msg*/
/*  @mdgen OWNER: mpformats/fmt.**/

namespace ::doctools {
    /*  Data storage in the doctools module*/
    /*  -------------------------------*/
    /* */
    /*  One namespace per object, containing*/
    /*   1) A list of additional search paths for format definition files.*/
    /*      This list extends the list of standard paths known to the module.*/
    /*      The paths in the list are searched before the standard paths.*/
    /*   2) Configuration information*/
    /*      a) string:  The format to use when converting the input.*/
    /*      b) boolean: A flag telling us whether to warn when visual markup*/
    /*         is used in the input, or not.*/
    /*      c) File information associated with the input, if any.*/
    /*      d) Module information associated with the input, if any.*/
    /*      e) Copyright information, if any*/
    /*   4) Name of the interpreter used to perform the syntax check of the*/
    /*      input (= allowed order of formatting commands).*/
    /*   5) Name of the interpreter containing the code coming from the format*/
    /*      definition file.*/
    /*   6) Name of the expander object used to interpret the input to convert.*/

    /*  commands is the list of subcommands recognized by the doctools objects*/
    variable commands [list     \
        "cget"          \
        "configure"         \
        "destroy"           \
        "format"            \
        "map"           \
        "search"            \
        "warnings"                  \
        "parameters"                \
        "param = "                  \
        ]

    /*  Only export the toplevel commands*/
    namespace export new search help

    /*  Global data*/

    /*   1) List of standard paths to look at when searching for a format*/
    /*      definition. Extensible.*/
    /*   2) Location of this file in the filesystem*/

    variable paths [list]
    variable here [file dirname [info script]]
}

/*  ::doctools::search --*/
/* */
/*  Extend the list of paths used when searching for format definition files.*/
/* */
/*  Arguments:*/
/*  path    Path to add to the list. The path has to exist, has to be a*/
/*                directory, and has to be readable.*/
/* */
/*  Results:*/
/*  None.*/
/* */
/*  Sideeffects:*/
/*  The specified path is added to the front of the list of search*/
/*  paths. This means that the new path is search before the*/
/*  standard paths set at module initialization time.*/

ret  ::doctools::search (type path) {
    variable paths

    if {![file exists      $path]} {return -code error "doctools::search: path does not exist"}
    if {![file isdirectory $path]} {return -code error "doctools::search: path is not a directory"}
    if {![file readable    $path]} {return -code error "doctools::search: path cannot be read"}

    set paths [linsert $paths 0 $path]
    return
}

/*  ::doctools::help --*/
/* */
/*  Return a string containing short help*/
/*  regarding the existing formatting commands.*/
/* */
/*  Arguments:*/
/*  None.*/
/* */
/*  Results:*/
/*  A string.*/

ret  ::doctools::help () {
    return "formatting commands\n\
        * manpage_begin - begin of manpage\n\
        * moddesc       - module description\n\
        * titledesc     - manpage title\n\
        * copyright     - copyright assignment\n\
        * manpage_end   - end of manpage\n\
        * require       - package requirement\n\
        * description   - begin of manpage body\n\
        * section       - begin new section of body\n\
        * subsection    - begin new sub-section of body\n\
        * para          - begin new paragraph\n\
        * list_begin    - begin a list\n\
        * list_end      - end of a list\n\
        * lst_item      - begin item of definition list\n\
        * call          - command definition, adds to synopsis\n\
        * usage         - see above, without adding to synopsis\n\
        * bullet        - begin item in bulleted list\n\
        * enum          - begin item in enumerated list\n\
        * arg_def       - begin item in argument list\n\
        * cmd_def       - begin item in command list\n\
        * opt_def       - begin item in option list\n\
        * tkoption_def  - begin item in tkoption list\n\
        * example       - example block\n\
        * example_begin - begin example\n\
        * example_end   - end of example\n\
        * see_also      - cross reference declaration\n\
        * keywords      - keyword declaration\n\
        * nl            - paragraph break in list items\n\
        * arg           - semantic markup - argument\n\
        * cmd           - semantic markup - command\n\
        * opt           - semantic markup - optional data\n\
        * comment       - semantic markup - comment\n\
        * sectref       - semantic markup - section reference\n\
        * syscmd        - semantic markup - system command\n\
        * method        - semantic markup - object method\n\
        * namespace     - semantic markup - namespace name\n\
        * option        - semantic markup - option\n\
        * widget        - semantic markup - widget\n\
        * fun           - semantic markup - function\n\
        * type          - semantic markup - data type\n\
        * package       - semantic markup - package\n\
        * class         - semantic markup - class\n\
        * var           - semantic markup - variable\n\
        * file          - semantic markup - file \n\
        * uri           - semantic markup - uri (optional label)\n\
        * term          - semantic markup - unspecific terminology\n\
        * const         - semantic markup - constant value\n\
        * emph          - emphasis\n\
        * strong        - emphasis, deprecated, usage is discouraged\n\
        "
}

/*  ::doctools::new --*/
/* */
/*  Create a new doctools object with a given name. May configure the object.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object.*/
/*  args    Options configuring the new object.*/
/* */
/*  Results:*/
/*  name    Name of the doctools created*/

ret  ::doctools::new (type name , type args) {
    
    if { [llength [info commands ::$name]] } {
    return -code error "command \"$name\" already exists, unable to create doctools object"
    }
    if {[llength $args] % 2 == 1} {
    return -code error "wrong # args: doctools::new name ?opt val...??"
    }

    # The arguments seem to be ok, setup the namespace for the object

    namespace eval ::doctools::doctools$name {
    variable paths      [list]
    variable format     ""
    variable formatfile ""
    variable deprecated 0
    variable file       ""
    variable module     ""
    variable copyright  ""
    variable format_ip  ""
    variable chk_ip     ""
    variable expander   "[namespace current]::ex"
    variable ex_ok      0
    variable msg        [list]
    variable param      [list]
    variable map ;      array set map {}
    }

    # Create the command to manipulate the object
    #                 $name -> ::doctools::DoctoolsProc $name
    interp alias {} ::$name {} ::doctools::DoctoolsProc $name

    # If the name was followed by arguments use them to configure the
    # object before returning its handle to the caller.

    if {[llength $args] > 1} {
    # Use linsert trick to make the command a pure list.
    eval [linsert $args 0 _configure $name]
    }
    return $name
}

/* */
/*  Private functions follow*/

/*  ::doctools::DoctoolsProc --*/
/* */
/*  Command that processes all doctools object commands.*/
/*  Dispatches any object command to the appropriate internal*/
/*  command implementing its functionality.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to manipulate.*/
/*  cmd Subcommand to invoke.*/
/*  args    Arguments for subcommand.*/
/* */
/*  Results:*/
/*  Varies based on command to perform*/

ret  ::doctools::DoctoolsProc (type name , optional cmd ="" , type args) {
    # Do minimal args checks here
    if { [llength [info level 0]] == 2 } {
    error "wrong # args: should be \"$name option ?arg arg ...?\""
    }
    
    # Split the args into command and args components

    if { [llength [info commands ::doctools::_$cmd]] == 0 } {
    variable commands
    set optlist [join $commands ", "]
    set optlist [linsert $optlist "end-1" "or"]
    return -code error "bad option \"$cmd\": must be $optlist"
    }
    return [eval [list ::doctools::_$cmd $name] $args]
}

/* */
/*  Method implementations follow (these are also private commands)*/

/*  ::doctools::_cget --*/
/* */
/*  Retrieve the current value of a particular option*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query*/
/*  option  Name of the option whose value we are asking for.*/
/* */
/*  Results:*/
/*  The value of the option*/

ret  ::doctools::_cget (type name , type option) {
    _configure $name $option
}

/*  ::doctools::_configure --*/
/* */
/*  Configure a doctools object, or query its configuration.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to configure*/
/*  args    Options and their values.*/
/* */
/*  Results:*/
/*  None if configuring the object.*/
/*  A list of all options and their values if called without arguments.*/
/*  The value of one particular option if called with a single argument.*/

ret  ::doctools::_configure (type name , type args) {
    upvar ::doctools::doctools${name}::format_ip  format_ip
    upvar ::doctools::doctools${name}::chk_ip     chk_ip
    upvar ::doctools::doctools${name}::expander   expander
    upvar ::doctools::doctools${name}::passes     passes

    if {[llength $args] == 0} {
    # Retrieve the current configuration.

    upvar ::doctools::doctools${name}::file       file
    upvar ::doctools::doctools${name}::module     module
    upvar ::doctools::doctools${name}::format     format
    upvar ::doctools::doctools${name}::copyright  copyright
    upvar ::doctools::doctools${name}::deprecated deprecated

    set     res [list]
    lappend res -file       $file
    lappend res -module     $module
    lappend res -format     $format
    lappend res -copyright  $copyright
    lappend res -deprecated $deprecated
    return $res

    } elseif {[llength $args] == 1} {
    # Query the value of one particular option.

    switch -exact -- [lindex $args 0] {
        -file {
        upvar ::doctools::doctools${name}::file file
        return $file
        }
        -module {
        upvar ::doctools::doctools${name}::module module
        return $module
        }
        -copyright {
        upvar ::doctools::doctools${name}::copyright copyright
        return $copyright
        }
        -format {
        upvar ::doctools::doctools${name}::format format
        return $format
        }
        -deprecated {
        upvar ::doctools::doctools${name}::deprecated deprecated
        return $deprecated
        }
        default {
        return -code error \
            "doctools::_configure: Unknown option \"[lindex $args 0]\", expected\
            -copyright, -file, -module, -format, or -deprecated"
        }
    }
    } else {
    # Reconfigure the object.

    if {[llength $args] % 2 == 1} {
        return -code error "wrong # args: doctools::_configure name ?opt val...??"
    }

    foreach {option value} $args {
        switch -exact -- $option {
        -file {
            upvar ::doctools::doctools${name}::file file
            set file $value
        }
        -module {
            upvar ::doctools::doctools${name}::module module
            set module $value
        }
        -copyright {
            upvar ::doctools::doctools${name}::copyright copyright
            set copyright $value
        }
        -format {
            if {[catch {
            set fmtfile [LookupFormat $name $value]
            SetupFormatter $name $fmtfile
            upvar ::doctools::doctools${name}::format format
            set format $value
            } msg]} {
            return -code error "doctools::_configure: -format: $msg"
            }
        }
        -deprecated {
            if {![string is boolean $value]} {
            return -code error \
                "doctools::_configure: -deprecated expected a boolean, got \"$value\""
            }
            upvar ::doctools::doctools${name}::deprecated deprecated
            set deprecated $value
        }
        default {
            return -code error \
                "doctools::_configure: Unknown option \"$option\", expected\
                -copyright, -file, -module, -format, or -deprecated"
        }
        }
    }
    }
    return ""
}

/*  ::doctools::_destroy --*/
/* */
/*  Destroy a doctools object, including its associated command and data storage.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to destroy.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::_destroy (type name) {
    # Check the object for sub objects which have to destroyed before
    # the namespace is torn down.
    namespace eval ::doctools::doctools$name {
    if {$format_ip != ""} {interp delete $format_ip}
    if {$chk_ip    != ""} {interp delete $chk_ip}

    # Expander objects have no delete/destroy method. This would
    # be a leak if not for the fact that an expander object is a
    # namespace, and we have arranged to make it a sub namespace of
    # the doctools object. Therefore tearing down our object namespace
    # also cleans up the expander object.
    # if {$expander != ""} {$expander destroy}

    }
    namespace delete ::doctools::doctools$name
    interp alias {} ::$name {}
    return
}

/*  ::doctools::_map --*/
/* */
/*  Add a mapping from symbolic to actual filename to the object.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to use*/
/*  sfname  Symbolic filename to map*/
/*  afname  Actual filename*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::_map (type name , type sfname , type afname) {
    upvar ::doctools::doctools${name}::map map
    set map($sfname) $afname
    return
}

/*  ::doctools::_format --*/
/* */
/*  Convert some text in doctools format*/
/*  according to the configuration in the object.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to use*/
/*  text    Text to convert.*/
/* */
/*  Results:*/
/*  The conversion result.*/

ret  ::doctools::_format (type name , type text) {
    upvar ::doctools::doctools${name}::format format
    if {$format == ""} {
    return -code error "$name: No format was specified"
    }

    upvar ::doctools::doctools${name}::format_ip format_ip
    upvar ::doctools::doctools${name}::chk_ip    chk_ip
    upvar ::doctools::doctools${name}::ex_ok     ex_ok
    upvar ::doctools::doctools${name}::expander  expander
    upvar ::doctools::doctools${name}::passes    passes
    upvar ::doctools::doctools${name}::msg       warnings

    if {!$ex_ok}       {SetupExpander  $name}
    if {$chk_ip == ""} {SetupChecker   $name}
    # assert (format_ip != "")

    set warnings [list]
    if {[catch {$format_ip eval fmt_initialize}]} {
    return -code error "Could not initialize engine"
    }
    set result ""

    for {
    set p $passes ; set n 1
    } {
    $p > 0
    } {
    incr p -1 ; incr n
    } {
    if {[catch {$format_ip eval [list fmt_setup $n]}]} {
        catch {$format_ip eval fmt_shutdown}
        return -code error "Could not initialize pass $n of engine"
    }
    $chk_ip eval ck_initialize

    if {[catch {set result [$expander expand $text]} msg]} {
        catch {$format_ip eval fmt_shutdown}
        # Filter for checker errors and reduce them to the essential message.

        if {![regexp {^Error in} $msg]}          {return -code error $msg}
        #set msg [join [lrange [split $msg \n] 2 end]]

        if {![regexp {^--> \(FmtError\) } $msg]} {return -code error "Doctools $msg"}
        set msg [lindex [split $msg \n] 0]
        regsub {^--> \(FmtError\) } $msg {} msg

        return -code error $msg
    }

    $chk_ip eval ck_complete
    }

    if {[catch {set result [$format_ip eval [list fmt_postprocess $result]]}]} {
    return -code error "Unable to post process final result"
    }
    if {[catch {$format_ip eval fmt_shutdown}]} {
    return -code error "Could not shut engine down"
    }
    return $result

}

/*  ::doctools::_search --*/
/* */
/*  Add a search path to the object.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to extend*/
/*  path    Search path to add.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::_search (type name , type path) {
    if {![file exists      $path]} {return -code error "$name search: path does not exist"}
    if {![file isdirectory $path]} {return -code error "$name search: path is not a directory"}
    if {![file readable    $path]} {return -code error "$name search: path cannot be read"}

    upvar ::doctools::doctools${name}::paths paths
    set paths [linsert $paths 0 $path]
    return
}

/*  ::doctools::_warnings --*/
/* */
/*  Return the warning accumulated during the last invocation of 'format'.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query*/
/* */
/*  Results:*/
/*  A list of warnings.*/

ret  ::doctools::_warnings (type name) {
    upvar ::doctools::doctools${name}::msg msg
    return $msg
}

/*  ::doctools::_parameters --*/
/* */
/*  Returns a list containing the parameters provided*/
/*  by the selected formatting engine.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query*/
/* */
/*  Results:*/
/*  A list of parameter names*/

ret  ::doctools::_parameters (type name) {
    upvar ::doctools::doctools${name}::param param
    return $param
}

/*  ::doctools::_setparam --*/
/* */
/*  Set a named engine parameter to a value.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query*/
/*  param   Name of the parameter to set.*/
/*  value   Value to set the parameter to.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::_setparam (type name , type param , type value) {
    upvar ::doctools::doctools${name}::format_ip format_ip

    if {$format_ip == {}} {
    return -code error \
        "Unable to set parameters without a valid format"
    }

    $format_ip eval [list fmt_varset $param $value]
    return
}

/* */
/*  Support commands*/

/*  ::doctools::LookupFormat --*/
/* */
/*  Search a format definition file based upon its name*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to use*/
/*  format  Name of the format to look for.*/
/* */
/*  Results:*/
/*  The file containing the format definition*/

ret  ::doctools::LookupFormat (type name , type format) {
    # Order of searching
    # 1) Is the name of the format an existing file ?
    #    If yes, take this file.
    # 2) Look for the file in the directories given to the object itself..
    # 3) Look for the file in the standard directories of this package.

    if {[file exists $format]} {
    return $format
    }

    upvar ::doctools::doctools${name}::paths opaths
    foreach path $opaths {
    set f [file join $path fmt.$format]
    if {[file exists $f]} {
        return $f
    }
    }

    variable paths
    foreach path $paths {
    set f [file join $path fmt.$format]
    if {[file exists $f]} {
        return $f
    }
    }

    return -code error "Unknown format \"$format\""
}

/*  ::doctools::SetupFormatter --*/
/* */
/*  Create and initializes an interpreter containing a*/
/*  formatting engine*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to manipulate*/
/*  format  Name of file containing the code of the engine*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::SetupFormatter (type name , type format) {

    # Create and initialize the interpreter first.
    # Use a transient variable. Interrogate the
    # engine and check its response. Bail out in
    # case of errors. Only if we pass the checks
    # we tear down the old engine and make the new
    # one official.

    variable here
    set mpip [interp create -safe] ; # interpreter for the formatting engine
    $mpip eval [list set auto_path $::auto_path]
    #set mpip [interp create] ; # interpreter for the formatting engine

    $mpip invokehidden source [file join $here api.tcl]
    #$mpip eval [list source [file join $here api.tcl]]
    interp alias $mpip dt_source   {} ::doctools::Source  $mpip [file dirname $format]
    interp alias $mpip dt_package  {} ::doctools::Package $mpip
    interp alias $mpip file        {} ::doctools::FileOp  $mpip
    interp alias $mpip puts_stderr {} ::puts stderr
    $mpip invokehidden source $format
    #$mpip eval [list source $format]

    # Check the engine for useability in doctools.

    foreach api {
    fmt_numpasses
    fmt_initialize
    fmt_setup
    fmt_postprocess
    fmt_shutdown
    fmt_listvariables
    fmt_varset
    } {
    if {[$mpip eval [list info commands $api]] == {}} {
        interp delete $mpip
        error "$format error: API incomplete, cannot use this engine"
    }
    }
    if {[catch {
    set passes [$mpip eval fmt_numpasses]
    }]} {
    interp delete $mpip
    error "$format error: Unable to query for number of passes"
    }
    if {![string is integer $passes] || ($passes < 1)} {
    interp delete $mpip
    error "$format error: illegal number of passes \"$passes\""
    }
    if {[catch {
    set parameters [$mpip eval fmt_listvariables]
    }]} {
    interp delete $mpip
    error "$format error: Unable to query for list of parameters"
    }

    # Passed the tests. Tear down existing engine,
    # and checker. The latter is destroyed because
    # of its aliases into the formatter, which are
    # now invalid. It will be recreated during the
    # next call of 'format'.

    upvar ::doctools::doctools${name}::formatfile formatfile
    upvar ::doctools::doctools${name}::format_ip  format_ip
    upvar ::doctools::doctools${name}::chk_ip     chk_ip
    upvar ::doctools::doctools${name}::expander   expander
    upvar ::doctools::doctools${name}::passes     xpasses
    upvar ::doctools::doctools${name}::param      xparam

    if {$chk_ip != {}}    {interp delete $chk_ip}
    if {$format_ip != {}} {interp delete $format_ip}

    set chk_ip    ""
    set format_ip ""

    # Now link engine API into it.

    interp alias $mpip dt_file      {} ::doctools::GetFile      $name
    interp alias $mpip dt_fileid    {} ::doctools::GetFileId    $name
    interp alias $mpip dt_module    {} ::doctools::GetModule    $name
    interp alias $mpip dt_copyright {} ::doctools::GetCopyright $name
    interp alias $mpip dt_format    {} ::doctools::GetFormat    $name
    interp alias $mpip dt_user      {} ::doctools::GetUser      $name
    interp alias $mpip dt_lnesting  {} ::doctools::ListLevel    $name
    interp alias $mpip dt_fmap      {} ::doctools::MapFile      $name
    interp alias $mpip file         {} ::doctools::FileCmd

    foreach cmd {cappend cget cis cname cpop cpush ctopandclear cset lb rb} {
    interp alias $mpip ex_$cmd {} $expander $cmd
    }

    set format_ip  $mpip
    set formatfile $format
    set xpasses    $passes
    set xparam     $parameters
    return
}

/*  ::doctools::SetupChecker --*/
/* */
/*  Create and initializes an interpreter for checking the usage of*/
/*  doctools formatting commands*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to manipulate*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::SetupChecker (type name) {
    # Create an interpreter for checking the usage of doctools formatting commands
    # and initialize it: Link it to the interpreter doing the formatting, the
    # expander object and the configuration information. All of which
    # is accessible through the token/handle (name of state/object array).

    variable here

    upvar ::doctools::doctools${name}::chk_ip    chk_ip
    if {$chk_ip != ""} {return}

    upvar ::doctools::doctools${name}::expander  expander
    upvar ::doctools::doctools${name}::format_ip format_ip

    set chk_ip [interp create] ; # interpreter hosting the formal format checker

    # Make configuration available through command, then load the code base.

    foreach {cmd ckcmd} {
    dt_search     SearchPaths
    dt_deprecated Deprecated
    dt_error      FmtError
    dt_warning    FmtWarning
    dt_where      Where
    } {
    interp alias $chk_ip $cmd {} ::doctools::$ckcmd $name
    }
    $chk_ip eval [list source [file join $here checker.tcl]]

    # Simple expander commands are directly routed back into it, no
    # checking required.

    foreach cmd {cappend cget cis cname cpop cpush ctopandclear cset lb rb} {
    interp alias $chk_ip $cmd {} $expander $cmd
    }

    # Link the formatter commands into the checker. We use the prefix
    # 'fmt_' to distinguish them from the checking commands.

    foreach cmd {
    manpage_begin moddesc titledesc copyright manpage_end require
    description section para list_begin list_end lst_item call
    bullet enum example example_begin example_end see_also
    keywords nl arg cmd opt comment sectref syscmd method option
    widget fun type package class var file uri usage term const
    arg_def cmd_def opt_def tkoption_def emph strong plain_text
    namespace subsection
    } {
    interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd
    }
    return
}

/*  ::doctools::SetupExpander --*/
/* */
/*  Create and initializes the expander for input*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to manipulate*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::SetupExpander (type name) {
    upvar ::doctools::doctools${name}::ex_ok    ex_ok
    if {$ex_ok} {return}

    upvar ::doctools::doctools${name}::expander expander
    ::textutil::expander $expander
    $expander evalcmd [list ::doctools::Eval $name]
    $expander textcmd plain_text
    set ex_ok 1
    return
}

/*  ::doctools::SearchPaths --*/
/* */
/*  API for checker. Returns list of search paths for format*/
/*  definitions. Used to look for message catalogs as well.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::SearchPaths (type name) {
    upvar ::doctools::doctools${name}::paths opaths
    variable paths

    set p $opaths
    foreach s $paths {lappend p $s}
    return $p
}

/*  ::doctools::Deprecated --*/
/* */
/*  API for checker. Returns flag determining*/
/*  whether visual markup is warned against, or not.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::Deprecated (type name) {
    upvar ::doctools::doctools${name}::deprecated deprecated
    return $deprecated
}

/*  ::doctools::FmtError --*/
/* */
/*  API for checker. Called when an error occurred.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/*  text    Error message*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::FmtError (type name , type text) {
    return -code error "(FmtError) $text"
}

/*  ::doctools::FmtWarning --*/
/* */
/*  API for checker. Called when a warning was generated*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object*/
/*  text    Warning message*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::FmtWarning (type name , type text) {
    upvar ::doctools::doctools${name}::msg msg
    lappend msg $text
    return
}

/*  ::doctools::Where --*/
/* */
/*  API for checker. Called when the current location is needed*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object*/
/* */
/*  Results:*/
/*  List containing offset, line, column*/

ret  ::doctools::Where (type name) {
    upvar ::doctools::doctools${name}::expander expander
    return [$expander where]
}

/*  ::doctools::Eval --*/
/* */
/*  API for expander. Routes the macro invocations*/
/*  into the checker interpreter*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::Eval (type name , type macro) {
    upvar ::doctools::doctools${name}::chk_ip chk_ip

    #puts stderr "\t\t$name [lindex [split $macro] 0]"

    # Handle the [include] command directly
    if {[string match include* $macro]} {
    foreach {cmd filename} $macro break
    return [ExpandInclude $name $filename]
    }

    # Rewrite the [namespace] command before passing it on.
    # "namespace" is a special command. The interpreter the validator
    # resides in uses the package "msgcat", which in turn uses the
    # builtin namespace. So the builtin cannot be simply
    # overwritten. We use a different name.

    if {[string match namespace* $macro]} {
    set macro _$macro
    }
    return [$chk_ip eval $macro]
}

/*  ::doctools::ExpandInclude --*/
/* */
/*  Handle inclusion of files.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/*  path    Name of file to include and expand.*/
/* */
/*  Results:*/
/*  None.*/

ret  ::doctools::ExpandInclude (type name , type path) {
    upvar ::doctools::doctools${name}::file file

    set ipath [file join [file dirname $file] $path]
    if {![file exists $ipath]} {
    set ipath $path
    if {![file exists $ipath]} {
        return -code error "Unable to find include file \"$path\""
    }
    }

    set    chan [open $ipath r]
    set    text [read $chan]
    close $chan

    upvar ::doctools::doctools${name}::expander  expander

    return [$expander expand $text]
}

/*  ::doctools::GetUser --*/
/* */
/*  API for formatter. Returns name of current user*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  String, name of current user.*/

ret  ::doctools::GetUser (type name) {
    global  tcl_platform
    return $tcl_platform(user)
}

/*  ::doctools::GetFile --*/
/* */
/*  API for formatter. Returns file information*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  File information*/

ret  ::doctools::GetFile (type name) {

    #puts stderr "GetFile $name"

    upvar ::doctools::doctools${name}::file file

    #puts stderr "ok $file"
    return $file
}

/*  ::doctools::GetFileId --*/
/* */
/*  API for formatter. Returns file information (truncated to stem of filename)*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  File information*/

ret  ::doctools::GetFileId (type name) {
    return [file rootname [file tail [GetFile $name]]]
}

/*  ::doctools::FileCmd --*/
/* */
/*  API for formatter. Restricted implementation of file.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  Module information*/

ret  ::doctools::FileCmd (type cmd , type args) {
    switch -exact -- $cmd {
    split {return [eval file split $args]}
    join  {return [eval file join $args]}
    }
    return -code error "Illegal subcommand: $cmd $args"
}

/*  ::doctools::GetModule --*/
/* */
/*  API for formatter. Returns module information*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  Module information*/

ret  ::doctools::GetModule (type name) {
    upvar ::doctools::doctools${name}::module module
    return   $module
}

/*  ::doctools::GetCopyright --*/
/* */
/*  API for formatter. Returns copyright information*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  Copyright information*/

ret  ::doctools::GetCopyright (type name) {
    upvar ::doctools::doctools${name}::copyright copyright
    return   $copyright
}

/*  ::doctools::GetFormat --*/
/* */
/*  API for formatter. Returns format information*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  Format information*/

ret  ::doctools::GetFormat (type name) {
    upvar ::doctools::doctools${name}::format format
    return $format
}

/*  ::doctools::ListLevel --*/
/* */
/*  API for formatter. Returns number of open lists*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/* */
/*  Results:*/
/*  Boolean flag.*/

ret  ::doctools::ListLevel (type name) {
    upvar ::doctools::doctools${name}::chk_ip chk_ip
    return [$chk_ip eval LNest]
}

/*  ::doctools::MapFile --*/
/* */
/*  API for formatter. Maps symbolic to actual filename in a doctools*/
/*  item. If no mapping is found it is assumed that the symbolic name*/
/*  is also the actual name.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to query.*/
/*  fname   Symbolic name of the file.*/
/* */
/*  Results:*/
/*  Actual name of the file.*/

ret  ::doctools::MapFile (type name , type fname) {
    upvar ::doctools::doctools${name}::map map

    #parray map

    if {[info exists map($fname)]} {
    return $map($fname)
    }
    return $fname
}

/*  ::doctools::Source --*/
/* */
/*  API for formatter. Used by engine to ask for*/
/*  additional script files support it.*/
/* */
/*  Arguments:*/
/*  name    Name of the doctools object to change.*/
/* */
/*  Results:*/
/*  Boolean flag.*/

ret  ::doctools::Source (type ip , type path , type file) {
    #puts stderr "$ip (source $path $file)"

    $ip invokehidden source [file join $path [file tail $file]]
    #$ip eval [list source [file join $path [file tail $file]]]
    return
}


ret  ::doctools::Locate (type p) {
    # @mdgen NODEP: doctools::__undefined__
    catch {package require doctools::__undefined__}

    #puts stderr "auto_path = [join $::auto_path \n]"

    # Check if requested package is in the list of loadable packages.
    # Then get the highest possible version, and then the index script

    if {[lsearch -exact [package names] $p] < 0} {
    return -code error "Unknown package $p"
    }

    set v  [lindex [lsort -increasing [package versions $p]] end]

    #puts stderr "Package $p = $v"

    return [package ifneeded $p $v]
}

ret  ::doctools::FileOp (type ip , type args) {
    #puts stderr "$ip (file $args)"
    # -- FUTURE -- disallow unsafe operations --

    return [eval [linsert $args 0 file]]
}


ret  ::doctools::Package (type ip , type pkg) {
    #puts stderr "$ip package require $pkg"

    set indexScript [Locate $pkg]

    $ip expose source
    $ip expose load
    $ip eval        $indexScript
    $ip hide   source
    $ip hide   load
    #$ip eval [list source [file join $path [file tail $file]]]
    return
}

/* ------------------------------------*/
/*  Module initialization*/

namespace ::doctools {
    /*  Reverse order of searching. First to search is specified last.*/

    /*  FOO/doctools.tcl*/
    /*  => FOO/mpformats*/

    /* catch {search [file join $here                lib doctools mpformats]}*/
    /* catch {search [file join [file dirname $here] lib doctools mpformats]}*/
    catch {search [file join $here                             mpformats]}
}

package provide doctools 1.3