1# -*- tcl -*- 2# checker_idx.tcl 3# 4# Code used inside of a checker interpreter to ensure correct usage of 5# docidx formatting commands. 6# 7# Copyright (c) 2003-2009 Andreas Kupries <andreas_kupries@sourceforge.net> 8 9# L10N 10 11package require msgcat 12 13proc ::msgcat::mcunknown {locale code} { 14 return "unknown error code \"$code\" (for locale $locale)" 15} 16 17if {0} { 18 puts stderr "Locale [::msgcat::mcpreferences]" 19 foreach path [dt_search] { 20 puts stderr "Catalogs: [::msgcat::mcload $path] - $path" 21 } 22} else { 23 foreach path [dt_search] { 24 ::msgcat::mcload $path 25 } 26} 27 28# State, and checker commands. 29# ------------------------------------------------------------- 30# 31# Note that the code below assumes that a command XXX provided by the 32# formatter engine is accessible under the name 'fmt_XXX'. 33# 34# ------------------------------------------------------------- 35 36global state 37 38# State machine ... State centered 39# --------------+-----------------------+---------------------- 40# state | allowed commands | new state (if any) 41# --------------+-----------------------+---------------------- 42# all except | include vset | 43# ==============+=======================+====================== 44# idx_begin | idx_begin | -> contents 45# --------------+-----------------------+---------------------- 46# contents | key | -> ref_series 47# --------------+-----------------------+---------------------- 48# ref_series | manpage | -> refkey_series 49# | url | 50# --------------+-----------------------+---------------------- 51# refkey_series | manpage | -> refkey_series 52# | url | 53# +-----------------------+----------- 54# | key | -> ref_series 55# +-----------------------+----------- 56# | idx_end | -> done 57# --------------+-----------------------+---------------------- 58 59# State machine, as above ... Command centered 60# --------------+-----------------------+---------------------- 61# state | allowed commands | new state (if any) 62# --------------+-----------------------+---------------------- 63# all except | include vset | 64# ==============+=======================+====================== 65# idx_begin | idx_begin | -> contents 66# --------------+-----------------------+---------------------- 67# contents | key | -> ref_series 68# refkey_series | | 69# --------------+-----------------------+---------------------- 70# ref_series | manpage | -> refkey_series 71# refkey_series | | 72# --------------+-----------------------+---------------------- 73# ref_series | url | -> refkey_series 74# refkey_series | | 75# --------------+-----------------------+---------------------- 76# refkey_series | idx_end | -> done 77# --------------+-----------------------+---------------------- 78 79# ------------------------------------------------------------- 80# Helpers 81proc Error {code {text {}}} { 82 global state 83 84 # Problematic command with all arguments (we strip the "ck_" prefix!) 85 # -*- future -*- count lines of input, maintain history buffer, use 86 # -*- future -*- that to provide some context here. 87 88 set cmd [lindex [info level 1] 0] 89 set args [lrange [info level 1] 1 end] 90 if {$args != {}} {append cmd " [join $args]"} 91 92 # Use a message catalog to map the error code into a legible message. 93 set msg [::msgcat::mc $code] 94 95 if {$text != {}} { 96 set msg [string map [list @ $text] $msg] 97 } 98 99 dt_error "IDX error ($code), \"$cmd\" : ${msg}." 100 return 101} 102proc Warn {code text} { 103 set msg [::msgcat::mc $code] 104 dt_warning "IDX warning ($code): [join [split [format $msg $text] \n] "\nIDX warning ($code): "]" 105 return 106} 107 108proc Is {s} {global state ; return [string equal $state $s]} 109proc IsNot {s} {global state ; return [expr {![string equal $state $s]}]} 110proc Go {s} {Log " >>\[$s\]" ; global state ; set state $s; return} 111proc Push {s} {Log " //\[$s\]" ; global state stack ; lappend stack $state ; set state $s; return} 112proc Pop {} {Log* " pop" ; global state stack ; set state [lindex $stack end] ; set stack [lrange $stack 0 end-1] ; Log " \\\\\[$state\]" ; return} 113proc State {} {global state ; return $state} 114 115proc Enter {cmd} {Log* "\[[State]\] $cmd"} 116 117#proc Log* {text} {puts -nonewline $text} 118#proc Log {text} {puts $text} 119proc Log* {text} {} 120proc Log {text} {} 121 122# ------------------------------------------------------------- 123# Framing 124proc ck_initialize {} { 125 global state ; set state idx_begin 126 global stack ; set stack [list] 127} 128proc ck_complete {} { 129 if {[Is done]} { 130 return 131 } else { 132 Error end/open/idx 133 } 134 return 135} 136# ------------------------------------------------------------- 137# Plain text 138proc plain_text {text} { 139 # Ignore everything which is only whitespace ... 140 # Beyond that plain text is not allowed. 141 142 set redux [string map [list " " "" "\t" "" "\n" ""] $text] 143 if {$redux == {}} {return [fmt_plain_text $text]} 144 Error idx/plaintext 145 return "" 146} 147 148# ------------------------------------------------------------- 149# Variable handling ... 150 151proc vset {var args} { 152 switch -exact -- [llength $args] { 153 0 { 154 # Retrieve contents of variable VAR 155 upvar #0 __$var data 156 return $data 157 } 158 1 { 159 # Set contents of variable VAR 160 global __$var 161 set __$var [lindex $args 0] 162 return "" ; # Empty string ! Nothing for output. 163 } 164 default { 165 return -code error "wrong#args: set var ?value?" 166 } 167 } 168} 169 170# ------------------------------------------------------------- 171# Formatting commands 172proc index_begin {label title} { 173 Enter index_begin 174 if {[IsNot idx_begin]} {Error idx/begincmd} 175 Go contents 176 fmt_index_begin $label $title 177} 178proc index_end {} { 179 Enter index_end 180 if {[IsNot refkey_series] && [IsNot contents]} {Error idx/endcmd} 181 Go done 182 fmt_index_end 183} 184proc key {text} { 185 Enter key 186 if {[IsNot contents] && [IsNot refkey_series]} {Error idx/keycmd} 187 Go ref_series 188 fmt_key $text 189} 190proc manpage {file label} { 191 Enter manpage 192 if {[IsNot ref_series] && [IsNot refkey_series]} {Error idx/manpagecmd} 193 Go refkey_series 194 fmt_manpage $file $label 195} 196proc url {url label} { 197 Enter url 198 if {[IsNot ref_series] && [IsNot refkey_series]} {Error idx/urlcmd} 199 Go refkey_series 200 fmt_url $url $label 201} 202proc comment {text} { 203 if {[Is done]} {Error idx/nodonecmd} 204 return ; #fmt_comment $text 205} 206 207# ------------------------------------------------------------- 208