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