checker_toc.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  checker_toc.tcl*/
/* */
/*  Code used inside of a checker interpreter to ensure correct usage of*/
/*  doctoc formatting commands.*/
/* */
/*  Copyright (c) 2003 Andreas Kupries <andreas_kupries@sourceforge.net>*/

/*  L10N*/

package require msgcat

ret  ::msgcat::mcunknown (type locale , type code) {
    return "unknown error code \"$code\" (for locale $locale)"
}

if {0} {
    puts stderr "Locale [::msgcat::mcpreferences]"
    foreach path [dt_search] {
    puts stderr "Catalogs: [::msgcat::mc
    }
} else {
    foreach path [dt_search] {
    ::msgcat::mc
    }
}

/*  State, and checker commands.*/
/*  -------------------------------------------------------------*/
/* */
/*  Note that the code below assumes that a command XXX provided by the*/
/*  formatter engine is accessible under the name 'fmt_XXX'.*/
/* */
/*  -------------------------------------------------------------*/

global state

/*  State machine ... State centered*/
/*  --------------+-----------------------+----------------------*/
/*  state       | allowed commands  | new state (if any)*/
/*  --------------+-----------------------+----------------------*/
/*  all except  | include vset      |*/
/*  ==============+=======================+======================*/
/*  toc_begin   | toc_begin     | -> contents*/
/*  --------------+-----------------------+----------------------*/
/*  contents    | item          | -> item_series*/
/*      +-----------------------+-----------*/
/*      | division_start    | -> end, PUSH division*/
/*  --------------+-----------------------+----------------------*/
/*  item_series | item          | -> item_series*/
/*      +-----------------------+-----------*/
/*      | toc_end       | -> done*/
/*  --------------+-----------------------+----------------------*/
/*  division    | item          | -> div_items*/
/*      +-----------------------+-----------*/
/*      | division_start    | -> div_series, PUSH division*/
/*  --------------+-----------------------+----------------------*/
/*  div_series  | division_start    | -> div_series, PUSH division*/
/*  --------------+-----------------------+----------------------*/
/*  div_items   | item          | -> div_items*/
/*      +-----------------------+-----------*/
/*      | division_end      | POP (-> div_series / -> end)*/
/*  --------------+-----------------------+----------------------*/
/*  end     | toc_end       | -> done*/
/*      +-----------------------+-----------*/
/*      | division_start    | PUSH division*/
/*  --------------+-----------------------+----------------------*/

/*  State machine, as above ... Command centered*/
/*  --------------+-----------------------+----------------------*/
/*  state       | allowed commands  | new state (if any)*/
/*  --------------+-----------------------+----------------------*/
/*  all except  | include vset      |*/
/*  ==============+=======================+======================*/
/*  toc_begin   | toc_begin     | -> contents*/
/*  --------------+-----------------------+----------------------*/
/*  contents    | item          | -> item_series*/
/*  item_series |           | -> item_series*/
/*  div_items   |           | -> div_items*/
/*  division      |                       | -> div_items*/
/*  --------------+-----------------------+----------------------*/
/*  contents    | division_start    | -> end, PUSH division*/
/*  div_series  |           | -> div_series, PUSH division*/
/*  end     |           | PUSH division*/
/*  division      |                       | PUSH division*/
/*  --------------+-----------------------+----------------------*/
/*  div_items   | division_end      | POP (-> div_series / -> end)*/
/*  --------------+-----------------------+----------------------*/
/*  item_series | toc_end       | -> done*/
/*  end     |           | -> done*/
/*  --------------+-----------------------+----------------------*/

/*  -------------------------------------------------------------*/
/*  Helpers*/
ret  Error (type code , optional text ={)} {
    global state

    # Problematic command with all arguments (we strip the "ck_" prefix!)
    # -*- future -*- count lines of input, maintain history buffer, use
    # -*- future -*- that to provide some context here.

    set cmd  [lindex [info level 1] 0]
    set args [lrange [info level 1] 1 end]
    if {$args != {}} {append cmd " [join $args]"}

    /*  Use a message catalog to map the error code into a legible message.*/
     msg =  [::msgcat::mc $code]

    if {$text != {}} {
     msg =  [string map [list @ $text] $msg]
    }

    dt_error "TOC error ($code), \"$cmd\" : ${msg}."
    return
}
ret  Warn (type code , type text) {
    set msg [::msgcat::mc $code]
    dt_warning "TOC warning ($code): [join [split [format $msg $text] \n] "\nTOC warning ($code): "]"
    return
}

ret  Is    (type s) {global state ; return [string equal $state $s]}
ret  IsNot (type s) {global state ; return [expr {![string equal $state $s]}]}
ret  Go    (type s) {Log " >>\[$s\]" ; global state ; set state $s; return}
ret  Push  (type s) {Log " //\[$s\]" ; global state stack ; lappend stack $state ; set state $s; return}
ret  Pop   ()  {Log* " pop" ;  global state stack ; set state [lindex $stack end] ; set stack [lrange $stack 0 end-1] ; Log " \\\\\[$state\]" ; return}
ret  State () {global state stack ; return "$stack || $state"}

ret  Enter (type cmd) {Log* "\[[State]\] $cmd"}

/* proc Log* {text} {puts -nonewline $text}*/
/* proc Log  {text} {puts            $text}*/
ret  Log* (type text) {}
ret  Log  (type text) {}

/*  -------------------------------------------------------------*/
/*  Framing*/
ret  ck_initialize () {
    global state   ; set state toc_begin
    global stack   ; set stack [list]
}
ret  ck_complete () {
    if {[Is done]} {
    return
    } else {
    Error end/open/toc
    }
    return
}
/*  -------------------------------------------------------------*/
/*  Plain text*/
ret  plain_text (type text) {
    # Ignore everything which is only whitespace ...
    # Beyond that plain text is not allowed.

    set redux [string map [list " " "" "\t" "" "\n" ""] $text]
    if {$redux == {}} {return [fmt_plain_text $text]}
    Error toc/plaintext
    return ""
}

/*  -------------------------------------------------------------*/
/*  Variable handling ...*/

ret  vset (type var , type args) {
    switch -exact -- [llength $args] {
    0 {
        # Retrieve contents of variable VAR
        upvar #0 __$var data
        return $data
    }
    1 {
        # Set contents of variable VAR
        global __$var
        set    __$var [lindex $args 0]
        return "" ; # Empty string ! Nothing for output.
    }
    default {
        return -code error "wrong#args: set var ?value?"
    }
    }
}

/*  -------------------------------------------------------------*/
/*  Formatting commands*/
ret  toc_begin (type label , type title) {
    Enter toc_begin
    if {[IsNot toc_begin]} {Error toc/begincmd}
    Go contents
    fmt_toc_begin $label $title
}
ret  toc_end () {
    Enter toc_end
    if {[IsNot end] && [IsNot item_series]} {Error toc/endcmd}
    Go done
    fmt_toc_end
}
ret  division_start (type title , optional symfile ={)} {
    Enter division_start
    if {
    [IsNot contents] && [IsNot div_series] && [IsNot end] && [IsNot division]
    } {Error toc/sectcmd}
    if {[Is contents] || [Is end]} {Go end} else {Go div_series}
    Push div_series
    fmt_division_start $title $symfile
}
ret  division_end () {
    Enter division_end
    if {[IsNot div_items] && [IsNot div_series]} {Error toc/sectecmd [State]}
    Pop
    fmt_division_end
}
ret  item (type file , type label , type desc) {
    Enter item
    if {
    [IsNot div_series] && [IsNot contents] && [IsNot item_series] && [IsNot div_items]
    } {
    Error toc/itemcmd
    }
    if {[Is div_items] || [Is div_series]} {Go div_items} else {Go item_series}
    fmt_item $file $label $desc
}
ret  comment (type text) {
    if {[Is done]} {Error toc/nodonecmd}
    return ; #fmt_comment $text
}

/*  -------------------------------------------------------------*/