_common.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/* */
/*  _common.tcl*/
/* */
/*  (c) 2001 Andreas Kupries <andreas_kupries@sourceforge.net>*/
/*  (c) 2002 Andreas Kupries <andreas_kupries@sourceforge.net>*/

/* */
/*  The code here contains general definitions for API functions and*/
/*  state information. They are used by several formatters to simplify*/
/*  their own code.*/

global    state
array  state =  {}

ret  fmt_initialize () {
    global    state
    unset     state

    set state(pass)   unknown ; # Not relevant before a pass
    set state(begun)  unknown ; # is active
    set state(mdesc)  {}      ; # Text, module desciption
    #set state(tdesc) {}      ; # Text, title of manpage
    set state(copyright) {}   ; # Text, copyright assignment (list)
    return
}

ret  fmt_shutdown      ()             {return}
ret  fmt_numpasses     ()             {return 2}
ret  fmt_postprocess   (type text)         {return $text}
ret  fmt_plain_text    (type text)         {return $text}
ret  fmt_listvariables ()             {return {}}
ret  fmt_varset        (type varname , type text) {return}

ret  fmt_setup (type n) {
    # Called to setup a pass through the input.

    global state
    set    state(pass)  $n  ; # We are in pass 'n' through the text.
    set    state(begun) 0   ; # No manpage_begin yet

    if {$n == 1} {c_xref_init}

    SetPassProcs $n
    return
}

/* */
/*  Functions made available to the formatter to access the common*/
/*  state managed here.*/

ret  c_inpass () {global state ; return $state(pass)}

ret  c_begin () {global state ; set     state(begun) 1 ; return}
ret  c_begun () {global state ; return $state(begun)}

ret  c_get_module ()     {global state ; return $state(mdesc)}
ret  c_set_module (type text) {global state ; set     state(mdesc) $text ; return}

ret  c_set_title (type text) {global state ; set state(tdesc) $text ; return}
ret  c_get_title () {
    global state
    if {![info exists state(tdesc)]} {
    return $state(mdesc)
    }
    return $state(tdesc)
}

ret  c_copyrightsymbol () {return "(c)"}
ret  c_set_copyright (type text) {global state ; lappend state(copyright) $text ; return}
ret  c_get_copyright ()     {
    global state

    set cc $state(copyright)
    if {$cc == {}} {set cc [dt_copyright]}
    if {$cc == {}} {return {}}

    return "Copyright [c_copyrightsymbol] [join $cc "\nCopyright [c_copyrightsymbol] "]"
}

ret  c_provenance () {
    return "Generated from file '[dt_file]' by tcllib/doctools with format '[dt_format]'"
}

/* */
/*  Manage pass-dependent procedure definitions.*/

global PassProcs

/*  pass $passNo procName procArgs { body  } --*/
/*  Specifies procedure definition for pass $n.*/
/* */
ret  c_pass (type pass , type proc , type arguments , type body) {
    global  PassProcs
    lappend PassProcs($pass) $proc $arguments $body
}
ret  SetPassProcs (type pass) {
    global PassProcs
    foreach {proc args body} $PassProcs($pass) {
    proc $proc $args $body
    }
}


/* */
/*  Manage a set of buffers to hold information between passes.*/
/*  Each buffer holds a list of lines.*/

global Buffers

/*  holdBuffers buffer ? buffer ...? --*/
/*  Declare a list of hold buffers,*/
/*  to collect data in one pass and output it later.*/
/* */
ret  c_holdBuffers (type args) {
    global Buffers
    foreach arg $args {
    set Buffers($arg) [list]
    }
}

ret  c_holdRemove (type args) {
    global Buffers
    foreach arg $args {
    catch {unset Buffers($arg)}
    }
    return
}

/*  hold buffer text --*/
/*  Append text to named buffer*/
/* */
ret  c_hold (type buffer , type entry) {
    global  Buffers
    lappend Buffers($buffer) $entry

    #puts "$buffer -- $entry"
    return
}

ret  c_holding (type buffer) {
    global  Buffers
    set l 0
    catch {set l [llength $Buffers($buffer)]}
    return $l
}

/*  held buffer --*/
/*  Returns current contents of named buffer and empty the buffer.*/
/* */
ret  c_held (type buffer) {
    global Buffers
    set content [join $Buffers($buffer) "\n"]
    set Buffers($buffer) [list]
    return $content
}

/* */
/*  Nested counter*/

global counters cnt
    counters =  [list]
    cnt =  0

ret  c_cnext () {global cnt ; incr cnt}
ret  c_cinit () {
    global counters cnt
    set counters [linsert $counters 0 $cnt]
    set cnt      0
    return
}
ret  c_creset () {
    global counters cnt
    set cnt      [lindex $counters 0]
    set counters [lrange $counters 1 end]
    return
}


/* */
/*  Utilities.*/
/* */

ret  NOP (type args) { }        ;/*  do nothing*/
ret  NYI (optional message ={)} {
    return -code error [append message " Not Yet Implemented"]
}

######################################################################
# Cross-reference tracking (for a single file).
#
global SectionNames ;# array mapping 'section name' to 'reference id'
global SectionList      ;# List of sections, their ids, and levels, in
set    SectionList {}   ;# order of definition.

# sectionId --
#   Format section name as an XML ID.
#
proc c_sectionId {name} {
    # Identical to '__sid' in checker.tcl
    regsub -all {[  ]+} [string tolower [string trim $name]] _ id
    regsub -all {"} $id _ id
    return $id
}

/*  possibleReference text gi --*/
/*  Check if $text is a potential cross-reference;*/
/*  if so, format as a reference;*/
/*  otherwise format as a $gi element.*/
/* */
ret  c_possibleReference (type text , type gi , optional label ={)} {
    global SectionNames
    if {![string length $label]} { label =  $text}
     id =  [c_sectionId $text]
    if {[info exists SectionNames($id)]} {
        return "[startTag ref refid $id]$label[endTag ref]"
    } else {
        return [wrap $label $gi]
    }
}

ret  c_newSection (type name , type level , type location) {
    global SectionList SectionNames
    set id          [c_sectionId $name]

    set SectionNames($id) .
    set SectionList [linsert $SectionList $location $name $id $level]
    return
}

ret  c_clrSections () {
    global SectionList SectionNames
    set    SectionList {}
    catch {unset SectionNames}
}

/* */
/*  Conversion specification.*/
/* */
/*  Two-pass processing.  The first pass collects text for the*/
/*  SYNOPSIS, SEE ALSO, and KEYWORDS sections, and the second pass*/
/*  produces output.*/
/* */

c_holdBuffers synopsis see_also keywords precomments

/* */
/*  Management of see-also and keyword cross-references*/

ret  c_xref_init () {
    global seealso  seealso__  ; set seealso  [list] ; catch {unset seealso__}  ; array set seealso__  {}
    global keywords keywords__ ; set keywords [list] ; catch {unset keywords__} ; array set keywords__ {}
}

ret  c_xref_seealso  () {global seealso  ; return $seealso}
ret  c_xref_keywords () {global keywords ; return $keywords}

c_pass 1 fmt_see_also {args} {
    global seealso seealso__
    foreach ref $args {
    if {[info exists seealso__($ref)]} continue
    lappend seealso $ref
         seealso = __($ref) .
    }
    return
}

c_pass 1 fmt_keywords {args} {
    global keywords keywords__
    foreach ref $args {
    if {[info exists keywords__($ref)]} continue
    lappend keywords $ref
         keywords = __($ref) .
    }
    return
}

c_pass 2 fmt_see_also {args} NOP
c_pass 2 fmt_keywords {args} NOP

/* */