#include <xml/pdoc-pfe.h>
#include <xml/pdoc-cpp.h>
#include <xml/nextpcre.h>
#include <xml/nextnode.h>
#include <xml/addspcre.h>
#include <xml/addsnode.h>
#include <xml/listnode.h>
#include <xml/pathnode.h>
#include <xml/attrnode.h>
#include <xml/savetree.h>
#include <xml/copynode.h>
#include <string.h>
#include <stdlib.h>

#define ___ {
#define ____ }

xml_GNode* xml_pdoc_pfe_wordset (xml_GNode* tree)
{
    g_return_val_if_fail (tree && tree->text, tree);

    ___ GError* error = 0;
    static const gchar* set1[] = 
{ "", " p4_listwords", 0 }
; static const gchar* set2[] =
{ "", " p4_countwords", 0 }
; xml_path_pcre_add9 (tree, "//item_cbloc", "+\\b(?:P4_)?LISTWORDS\\s*\\(\\s*(\\w+)\\s*\\)", set1, &error); xml_path_pcre_add9 (tree, "//item_cblock", "+\\b(?:P4_)?LISTWORDS\\s*\\(\\s*(\\w+)\\s*\\)", set1, &error); xml_path_pcre_add9 (tree, "//item_cbloc", "+\\b(?:P4_)?COUNTWORDS\\s*\\(\\s*(\\w+)\\s*,", set2, &error); xml_path_pcre_add9 (tree, "//item_cblock", "+\\b(?:P4_)?COUNTWORDS\\s*\\(\\s*(\\w+)\\s*,", set2, &error); ____; return tree; }
xml_GNode* xml_pdoc_pfe_grabfcode (xml_GNode* tree)
{
    static const gchar* names[] = 
        
{ "", "fcode_type", "fcode_name", 0 }
; if (! tree) return tree; ___ xml_GNode* node = tree->children; xml_GNode *next; // gsize off = tree->off; for (; node ; node = next)
{
        next = node->next;
        if (! node->name) continue;

        if (xml_node_hasname_as_(node, "*item_"))
        
{   xml_pdoc_pfe_grabfcode (node); continue; }
if (! xml_node_hasname_as_(node, "*comment")) continue; while (next && xml_node_hasname_eq_(next, "br")) next = next->next; if (! next || !xml_node_hasname_as_(next, "*bloc")) continue; /* check if the comment-node is followed by an FCode declaration */ if (! xml_strstr_match1 ( node->text->str, node->end, next->off, "*FCode")) continue; if (xml_pcre_match_add9 ( node->text->str, node->end, next->off, "+" "((?:[a-z]+\\s+)*" "F?X?Code)" "\\s*\\(\\s*" "(\\w+)" "\\s*\\)\\s*", tree, names))
{
            if (xml_node_hasname_as_(tree, "*item_"))
            
{
                while (node && ! xml_node_hasname_eq_(node, "fcode_name"))
                    node = node->next;
                if (node)
                    xml_node_attribute_add_value (
                        tree, "fcode_name", g_strndup (
                            node->text->str + node->off, 
                            node->end - node->off));
            }
}
}
____; return tree; }
xml_GNode*
xml_pdoc_pfe_forthdocs (xml_GNode* tree)
{
    static const gchar* names[] = 
        
{ "", "forth_name", "forth_stack", "?forth_hints", 0 }
; if (! tree) return tree; ___ xml_GNode* node = tree->children; /* ___ xml_GNode* from = node; // file start is a good one */ ___ xml_GNode* next; /* needed since grouping might modify node.next */ for (; node ; node = next)
{
        next = node->next;

        if (xml_node_hasname_as_(node, "*item_"))
        
{   xml_pdoc_pfe_forthdocs (node); continue; }
if (! xml_node_hasname_eq_(node, "ccomment")) continue; if (! node->children || ! xml_node_hasname_eq_(node->children, "doc")) continue; if (0) g_printerr ("CHECK-%s-%s-'%.*s'\n", node->name, node->children->name, (int)( node->children->end - node->children->off ), node->text->str + node->children->off); if (xml_pcre_match_adds9 ( node->text->str, node->children->off, node->children->end, "?" "\\s+(\"[^\"]+\")" "\\s+(\\([^()]+--[^()]+\\))" "\\s*(.*)", node, names))
{
            /* go and add the name as an attribute */
            continue;
        }
if (xml_pcre_match_adds9 ( node->text->str, node->children->off, node->children->end, "?" "\\s+(\'[^\']+\')" "\\s+(\\([^()]+--[^()]+\\))" "\\s*(.*)", node->children, names))
{
            /* go and add the name as an attribute */
            continue;
        }
if (xml_pcre_match_adds9 ( node->text->str, node->children->off, node->children->end, "?" "\\s+([^\\s()][^\\s]*)" "\\s+(\\([^()]+--[^()]+\\))" "\\s*(.*)", node->children, names))
{
            /* go and add the name as an attribute */
            continue;
        }
}
____;____; /* ____; */ return tree; }
xml_GNode* xml_pdoc_pfe_wordsets_listwords_exports (
    xml_GNode* tree, gpointer ignored)
{
    g_return_val_if_fail (tree && tree->text, tree);
    ___ gchar* wordset = xml_node_attribute_lookup (tree, "p4_listwords");
    g_return_val_if_fail (wordset, tree);
    ___ xml_GNode* node = tree->children;
    ___ xml_GNode* next;
    for (; node ; node = next)
    
{
        next = node->next;
        if (! xml_node_hasname_eq_(node, "cblock")) continue;
        xml_node_attribute_add (node, "wordset", wordset);
        xml_path_pcre_text_to_attr (node, "//*comment", "pushout", 0);
        /* xml_path_pcre_text_to_attr (node, "// *literal", "pushout", "_"); */
        /* all of the exports (a) start on a line (b) have an sliteral */
        ___ xml_GNode* line  = node->children; xml_GNode* ends;
        for (; line ; line = ends)
        
{
            while (! xml_node_hasname_eq_(line, "br"))
            
{ line = line->next; if (! line) break; }
if (! line) break; ends = line->next; if (! ends || ! xml_node_hasname_eq_(ends, "sliteral")) continue; while (! xml_node_hasname_eq_(ends, "br"))
{ ends = ends->next; if (! ends) break; }
if (! ends) break; /* <br>...<sliteral>...<br> : try to substructure '....'s */ ___ static const gchar* names1[] =
{ "", "export_type", "export_string", 0}
; xml_pcre_match_add9 ( node->text->str, line->end, ends->off, "?" "\\s*(\\w+)" "\\s*\\(" "\\s*\"((?:[^\"\\\\]|\\\\.)*)\"" "\\s*\\)\\s*,\\s*", node, names1); ____; ___ static const gchar* names2[] =
{ "", "export_type", "export_string", "export_value", 0}
; xml_pcre_match_add9 ( node->text->str, line->end, ends->off, "?" "\\s*(\\w+)" "\\s*\\(" "\\s*\"((?:[^\"\\\\]|\\\\.)*)\"" "\\s*,\\s*([^()]+)\\)\\s*,\\s*", node, names2); xml_pcre_match_add9 ( node->text->str, line->end, ends->off, "?" "\\s*(\\w+)" "\\s*\\(" "\\s*\"((?:[^\"\\\\]|\\\\.)*)\"" "\\s*,\\s*([^()]*\\([^()]*\\)[^()]*)\\)\\s*,\\s*", node, names2); ____; if (xml_node_hasname_eq_(line->next, "export_type"))
{
                xml_GNode* new1
                    = xml_node_group_inner_new (line, ends, "export_line");
                if (new1)
                
{
                    gchar* val = xml_node_attribute_lookup (line, "line");
                    if (val) xml_node_attribute_add (new1, "line", val);
                    if (wordset) 
                        xml_node_attribute_add (new1, "wordset", wordset);
                }
}
}
____; xml_path_pcre_text_restore (node, "//*comment", "pushout"); }
____;____;____; return tree; }
/*
   look into wordsets and markup their export-entries. Bind each with
   an attribute naming the wordset-identifier to look them up later
   more easily. Attach a type attribute and other attributes as well.
 */
xml_GNode* xml_pdoc_pfe_wordsets_exports (xml_GNode* tree)
{
    g_return_val_if_fail (tree && tree->text, tree);
    xml_path_node_foreach (tree, "//*@p4_listwords", (xml_GNodeForeachFunc)
                            xml_pdoc_pfe_wordsets_listwords_exports, 0);
    return tree;
}
/* _________________________________________________________________ */
/* in C, typedefs are global anyway */
typedef struct 
{ const gchar* a; const gchar* x; }
 mapping2_t;
typedef struct 
{ const gchar* a; const gchar* b; const gchar* x; }
 mapping3_t;
gchar* xml_pfe_export_type_strdup (const gchar* name, gssize len)
{
    if (! name) return (gchar*) name;
    if (len < 0) len = strlen (name);
    
    /* old into new */
    if (len == 2)
    
{
        static mapping2_t mapping2 [] = 
{
            
{ "CI", "P4_IXco" }
,
{ "OV", "P4_OVAR" }
,
{ "OC", "P4_OCON" }
,
{ "CS", "P4_SXco" }
,
{ "IV", "P4_IVAR" }
,
{ "IC", "P4_ICON" }
,
{ "CX", "P4_XXco" }
,
{ "OL", "P4_OVAL" }
,
{ "DV", "P4_DVAR" }
,
{ "CI", "P4_IXco" }
,
{ "IL", "P4_IVAL" }
,
{ "DC", "P4_DCON" }
,
{ 0, 0 }
}
; mapping2_t* M = mapping2; for (; M->a ; M++)
{
            if (!memcmp (name, M->a, 2)) 
            
{ name = M->x; len = strlen (name); break; }
}
}
/* short to long */ if (len == 7)
{
        /* exports with firstchar being lowercaps are forth dict names */
        static mapping3_t mapping7 [] = 
{
            
{ "P4_FXCO", "P4_FXco", "ordinary primitive" }
,
{ "P4_IXCO", "P4_IXco", "immediate primitive" }
,
{ "P4_SXCO", "P4_SXco", "compiling primitive" }
,
{ "P4_XXCO", "P4_XXco", "constructor primitive" }
,
{ "P4_RTCO", "P4_RTco", "definining primitive" }
,
{ "P4_OVAR", "P4_OVaR", "ordinary variable" }
,
{ "P4_IVAR", "P4_IVaR", "immediate variable" }
,
{ "P4_OVAL", "P4_OVaL", "ordinary valuevar" }
,
{ "P4_IVAL", "P4_IVaL", "immediate valuevar" }
,
{ "P4_OCON", "P4_OCoN", "ordinary constant" }
,
{ "P4_ICON", "P4_ICoN", "immediate constant" }
,
{ "P4_DVAR", "P4_DVaR", "threadstate variable" }
,
{ "P4_DCON", "P4_DCoN", "threadstate valueGET" }
,
{ "P4_DSET", "P4_DSeT", "threadstate valueSET" }
,
{ "P4_FNYM", "P4_FNyM", "forthword synonym" }
,
{ "P4_SNYM", "P4_SNyM", "immediate synonym" }
,
{ "P4_xOLD", "P4_OLDx", "obsolete forthword" }
,
{ "P4_iOLD", "P4_OLDi", "obsolete immediate" }
,
{ "P4_EXPT", "P4_XCPT", "- exception declared" }
,
{ "P4_OFFS", "P4_OFFs", "ordinary offsetval" }
,
{ "P4_OVOC", "P4_OVoc", "ordinary vocabulay" }
,
{ "P4_IVOC", "P4_IVoc", "immdatiate vocabulary" }
,
{ "P4_SLOT", "P4_slot", "- loading slot id" }
,
{ "P4_SSIZ", "P4_ssiz", "- loading slot size" }
,
{ "P4_INTO", "P4_into", "- loading into" }
,
{ "P4_LOAD", "P4_load", "- loading wordset" }
,
{ 0, 0, 0 }
}
; mapping3_t* M = mapping7; for (; M->a ; M++)
{
            if (!memcmp (name, M->a, 7) || !memcmp (name, M->b, 7)) 
            
{  return g_strdup (M->x);  }
}
}
return g_strdup_printf ("- loader type %.*s", len, name); }
gchar* xml_pfe_export_string_strdup (const gchar* name, gssize len)
{
    if (! name) return (gchar*) name;
    if (len < 0) len = strlen (name);
    ___ gchar* str = g_strndup (name, len);
    ___ gchar *p = str, *s = str;
    for (; *p ; p++)
    
{
        if (*p != '\\') 
{ *s++ = *p; continue; }
p++; if (! *p) break; if (g_ascii_isalpha (*p))
{ p++; continue; }
if (g_ascii_isdigit (*p))
{ *s++ = (*p-'0'); p++; continue; }
*s++ = *p; continue; }
*s = '\0'; return str; ____;____; }
gchar* xml_pfe_forth_name_strdup (const gchar* name, gssize len)
{
    if (! name) return (gchar*) name;
    if (len < 0) len = strlen (name);
    if ((name[0] == '"'  && name[len-1] == '"' )||
	(name[0] == '\'' && name[len-1] == '\'') )
        return xml_pfe_export_string_strdup (name+1, len-2);
    else
        return g_strndup (name, len);
}
static void per_item_cdoc (xml_GNode* node, gchar* name)
{
    xml_GList* list = xml_path_node_list (node, "//forth_name");
    if (list) 
    
{
        xml_GNode* seen = list->data.node;
        xml_node_attribute_add_value (node, name, 
            xml_pfe_forth_name_strdup (seen->text->str + seen->off, 
				       seen->end - seen->off));
        xml_g_list_free (list);
    }
}
static void per_export_line (xml_GNode* node, gchar* name)
{
    xml_GList* list = xml_path_node_list (node, "//export_string");
    if (list) 
    
{
        xml_GNode* seen = list->data.node;
        xml_node_attribute_add_value (node, name, 
            xml_pfe_export_string_strdup (seen->text->str + seen->off, 
					  seen->end - seen->off));
        xml_g_list_free (list);
    }
/* seen = xml_path_node (node, "//export_type"); */ list = xml_path_node_list (node, "//export_type"); if (list)
{
        xml_GNode* seen = list->data.node;
        xml_node_attribute_add_value (node, "export_type", 
            xml_pfe_export_type_strdup (seen->text->str + seen->off, 
					seen->end - seen->off));
        xml_g_list_free (list);
    }
}
xml_GNode*
xml_pdoc_pfe_export_attributes (xml_GNode* node)
{
    xml_path_node_foreach (node, "//item_cdoc",    (xml_GNodeForeachFunc) 
                            per_item_cdoc, (gpointer) "forth_name");
    xml_path_node_foreach (node, "//item_cblock",    (xml_GNodeForeachFunc) 
                            per_item_cdoc, (gpointer) "forth_name");
    xml_path_node_foreach (node, "//export_line",  (xml_GNodeForeachFunc)
                            per_export_line, (gpointer) "forth_name");
    return node;
}
/** ----------------------------------------------------------------------
   foreach wordset - enumerate each export with "<wordsetname>.<number>"
   which can be used as a unique reference across the tree. At the same
   we recognize "wordlist"-changers, and we add a "forth_wordlist"
   attribute into each export that says where it ends up. The combination
   of "forth_wordlist"+"forth_name" is usually unique, however that is
   not always the case. Only "wordset_name"+"forth_name" would be unique
   and a "forth_wordlist" may wrap multiple "wordset"s that could make
   for multiple forth_name definitions in the same wordlist.
  
   this is a counter-example - see => xml_pdoc_pfe_export_attributes
   implementation which uses => xml_path_node_foreach with an indirect
   function call per node, while we use => xml_path_node_list here
   that allocates a nodelist that we can walk with a simply "for". The
   earlier is more scalable while the latter prb. easier to maintain.
   (both could be the same if C 'd allowed nested function objects:
    http://gcc.gnu.org/onlinedocs/gcc-3.2.1/gcc/Nested-Functions.html)
 */
xml_GNode*
xml_pdoc_pfe_export_enumerate (xml_GNode* tree)
{
    xml_GList* wordset = xml_path_node_list (tree, "//cblock@wordset");
    for (; wordset; wordset = xml_g_list_free_head (wordset))
    
{
	xml_GNode* ws = wordset->data.node;
	xml_GList* exportlist = xml_path_node_list (ws, "//export_line");
	if (! exportlist) continue;

        ___ int id = 0;
	___ const gchar* wordlistname = "FORTH"; 
	for (; exportlist; exportlist = xml_g_list_free_head (exportlist))
	
{
	    xml_GNode* exports = exportlist->data.node;
	    gchar* name = xml_node_attribute_lookup (exports, "forth_name");
	    gchar* type = xml_node_attribute_lookup (exports, "export_type");
	    if (strstr (type, "loading"))
	    
{
		/* omit loading from output report - store only wordset refs */
		if (strstr (type, "into"))
		
{
		    if (! name || !strlen(name)) 
		    
{
			wordlistname = "FORTH";
		    }
else
{
			wordlistname = name;
			if (!strcmp (name, "[ANS]")|| !strcmp (name, "[FTH]"))
			
{ wordlistname = "FORTH"; }
}
}
}
else if (name)
{
                const gchar* wordset_name = 
                    xml_node_attribute_lookup (exports, "wordset");
                ++id;
                xml_node_attribute_add (exports, "wordlist", wordlistname);
                xml_node_attribute_add_value (exports, "forth_id",
                    g_strdup_printf ("%s.%i", wordset_name, id));
                xml_node_attribute_add_value (exports, "forth_find",
                    g_strdup_printf ("%s %s", wordlistname, name));
                xml_node_attribute_add_value (exports, "forth_spec",
                    g_strdup_printf ("%s %s", wordset_name, name));
            }
/* if not loading but name */ }
/* for */ ____; if (id) xml_node_attribute_add_value (ws, "forth_spec_entries", g_strdup_printf ("%i", id)); ____; }
return tree; }
/* ----------------------------------------------------------------------
   use the annotated input-tree to construct a new output tree which
   has another dtd, reordering things, and then looking not unlike
 <wordset>
    <export>
       <comment>
           <source>  */
#define UNDEF "(no special usage info)"
static void
xml_node_append_default (xml_GNode* node, xml_GNode* info, 
			 const gchar* newline)
{
    const gchar* name = xml_node_attribute_lookup (info, "forth_name");
    const gchar* type = xml_node_attribute_lookup (info, "export_type");
    xml_GNode* item = xml_node_append_node_new_data (node, "item_info");

    gchar* val = 0; 
    
{  /* = xml_node_attribute_lookup (info, "export_value"); */
	xml_GList* list = xml_path_node_list (info, "//export_value");
	if (list)
	
{
	    xml_GNode* seen = list->data.node;
	    val = g_strndup (seen->text->str + seen->off, 
			     seen->end - seen->off);
	    xml_g_list_free (list);
	}
}
if ((strstr (type, "constant") || strstr (type, "value")) && (strstr (type, "ordinary") || strstr (type, "immediate")))
{
	xml_node_append (item, "<screen/( %s ) %s %s>\n<p/an %s %s>\n",
			 val ? val : "?", strchr (type, ' '),
			 name, type, UNDEF);
    }
else if (strstr (type, "contructor"))
{
	xml_node_append (item, "<p/%s %s %s>\n<p/%s %s>\n",
			 type, name, val ? val : "...", 
			 UNDEF, " a constructor is executed while "
			 "starting the system or loading the extensin "
			 "module. It initialized the internal data "
			 "structures of that module. (In rare occasions "
			 "it might be useful to reinitialize these)");
    }
else if (strstr (type, "primitive"))
{
	xml_node_append (item, "<p/%s %s >\n<p/%s %s>\n<p/ %s %s>\n",
			 type, name, "an executable word ", UNDEF,
			 val ? "or wrapper call around" : "or wrapper", 
			 val ? val : "call of a library function");
    }
else if (strstr (type, "synonym"))
{
	/* the val has the form &quot;VALUE&quot; */
	xml_node_append (item, "<p/%s %s >\n<p/%s %s%s>\n<p/%s>\n", 
			 type, name, "is doing the same as", "=>",val,
			 "this word is provided only for compatibility "
			 "with common forth usage in programs. The"
			 "given synonym should be preferred however.");
    }
else if (strstr (type, "vocabulary"))
{
	/* the val has the form &quot;VALUE&quot; */
	xml_node_append (item, "<p/%s %s >\n<p/%s %s %s >\n", 
			 type, name, "This word is introducing a new "
			 "vocabulary named ",val," where words can be "
			 "added to as it can be done to FORTH when put "
			 "into DEFINITIONS access");
    }
else if (strstr (type, "obsolete"))
{
	/* the val has the form &quot;VALUE&quot; */
	xml_node_append (item, "<p/%s %s >\n<p/%s %s%s>\n<p/%s>\n", 
			 type, name, "is doing the same as", "=>",val,
			 "This word should be replaced. It will be "
			 "deleted in the near future. Instead use the "
			 "(newer) synonym word given above.");
    }
else
{
	xml_node_append (item, "<p/%s %s>\n<p/%s %s>\n", 
			 type, name, val ? val : "", UNDEF);
    }
if (val) g_free (val); if (newline) xml_node_append_string (node, newline); }
/** 
   old version - we do now expect the tree to be run through
   => xml_pdoc_pfe_export_enumerate followed by => xml_pdoc_pfe_comment_link
 */
xml_GNode*
xml_pdoc_pfe_make_wordset_tree_1 (xml_GNode* tree)
{
    xml_GNode* new1 = xml_tree_new ("pfewordlists", 0);
    xml_GList* wordset = xml_path_node_list (tree, "//cblock@wordset");
    for (; wordset; wordset = xml_g_list_free_head (wordset))
    
{
	xml_GNode* ws = wordset->data.node;
	xml_GList* exportlist = xml_path_node_list (ws, "//export_line");
	if (! exportlist) continue;
	ws = xml_node_append (new1, "<pfewordlist%p/",
			      wordset->data.node->attributes);

	___ const gchar* wordlist = "FORTH";
	for (; exportlist; exportlist = xml_g_list_free_head (exportlist))
	
{
	    xml_GNode* exports = exportlist->data.node;
	    gchar* name = xml_node_attribute_lookup (exports, "forth_name");
	    gchar* type = xml_node_attribute_lookup (exports, "export_type");
	    xml_node_append_string (ws, "\n");
	    if (strstr (type, "loading"))
	    
{
		/* omit loading from output report - store only wordset refs */
		if (strstr (type, "into"))
		
{
		    if (! name || !strlen(name)) 
		    
{
			wordlist = "FORTH";
		    }
else
{
			wordlist = name;
			if (!strcmp (name, "[ANS]")|| !strcmp (name, "[FTH]"))
			
{ wordlist = "FORTH"; }
}
}
}
else
{
		xml_GNode* item = xml_node_append (ws, "<pfeworditem/");
		xml_node_append (item, "\n<pfewordlist/%s>\n", wordlist);
		if (name) 
		
{
		    xml_GList* list = xml_path_node_list_with_attr_value (
			tree, "//item_cblock@forth_name", name);
		    if (list)
		    
{
			if (0) g_printerr ("<append \"%s\"/>\n", name);
			xml_node_append_copy (item, list->data.node, "\n");
			xml_g_list_free (list);
		    }
else
{
			if (0) g_printerr ("<no-append \"%s\"/>\n", name);
			xml_node_append_default (item, exports, "\n");
		    }
}
xml_node_attribute_add ( xml_node_rename(xml_node_append_copy (item, exports, "\n"), "pfeexport"), "forth_wordlist", wordlist); }
/* ! if loading */ }
/* for */ ____; xml_node_append_string (ws, "\n"); }
xml_node_append_string (new1, "\n"); return new1; }
/* ... trying another approach ... 
   in the following _2 function we do just replace the calll to
   xml_path_node_list_with_attr_value("//item_cblock@name") with a simple 
   search on a list of xml_path_node_list("//item_cblock@") instead. This
   is somewhat like a database-index. Since the usual PFE has more than
   1000 definition and even 100000 markups, this does speed up the execution.
*/
xml_GList* xml_list_find_with_attr_value (xml_GList* list, 
					  const gchar* xpath,
					  const gchar* value)
{
    /* we only recognize the latest part of the xpath */
    const gchar* name = strrchr (xpath, '/');
    if (name) 
{ name++; if (!*name) name = 0; }
if (!name)
{ name = xpath; }
___ const gchar* attr = strrchr (name, '@'); if (attr) attr++; if (!*attr) name = 0; if (!attr)
{ attr = name; name = 0; }
for (; list ; list = list->next)
{
	if (name)
	    while (memcmp (name, list->data.node->name, attr-1-name))
		if (! (list = list->next)) 
		    return 0;
	      
	___ gchar* val = xml_node_attribute_lookup (list->data.node, attr);
	if (! val) continue;
	if (! strcmp (val, value)) break;
	____;
	/* continue */
    }
; ____; return list; }
/** 
   old version - we do now expect the tree to be run through
   => xml_pdoc_pfe_export_enumerate followed by => xml_pdoc_pfe_comment_link
 */
xml_GNode*
xml_pdoc_pfe_make_wordset_tree_2 (xml_GNode* tree)
{
    xml_GList* cblocks = xml_path_node_list (tree, "//item_cblock@forth_name");
    xml_GNode* new1 = xml_tree_new ("pfewordlists", 0);
    xml_GList* wordset = xml_path_node_list (tree, "//cblock@wordset");
    for (; wordset; wordset = xml_g_list_free_head (wordset))
    
{
	xml_GNode* ws = wordset->data.node;
	xml_GList* exportlist = xml_path_node_list (ws, "//export_line");
	if (! exportlist) continue;
	ws = xml_node_append (new1, "<pfewordlist%p/",
			      wordset->data.node->attributes);

	___ const gchar* wordlist = "FORTH";
	for (; exportlist; exportlist = xml_g_list_free_head (exportlist))
	
{
	    xml_GNode* exports = exportlist->data.node;
	    gchar* name = xml_node_attribute_lookup (exports, "forth_name");
	    gchar* type = xml_node_attribute_lookup (exports, "export_type");
	    if (strstr (type, "loading"))
	    
{
		/* omit loading from output report - store only wordset refs */
		if (strstr (type, "into"))
		
{
		    if (! name || !strlen(name)) 
		    
{
			wordlist = "FORTH";
		    }
else
{
			wordlist = name;
			if (!strcmp (name, "[ANS]")|| !strcmp (name, "[FTH]"))
			
{ wordlist = "FORTH"; }
}
}
}
else
{
		xml_GNode* item = xml_node_append (ws, "\n<pfeworditem/\n");
		xml_node_append (item, "<pfewordlist/%s>\n", wordlist);
		if (name) 
		
{
		    xml_GList* found = xml_list_find_with_attr_value (
			cblocks, "//item_cblock@forth_name", name);
		    if (found)
		    
{
			if (0) g_printerr ("<append \"%s\"/>\n", name);
			xml_node_append_copy (item, found->data.node, "\n");
		    }
else
{
			if (0) g_printerr ("<no-append \"%s\"/>\n", name);
			xml_node_append_default (item, exports, "\n");
		    }
}
xml_node_attribute_add ( xml_node_rename(xml_node_append_copy (item, exports, "\n"), "pfeexport"), "forth_wordlist", wordlist); }
/* ! if loading */ }
/* for */ ____; xml_node_append_string (ws, "\n"); }
xml_node_append_string (new1, "\n"); xml_g_list_free (cblocks); return new1; }
#define _str_equal(X,Y) (! strcmp ((X),(Y)))
static xml_GNode* better_match (xml_GNode* node, 
                                xml_GNode* have, xml_GNode* test)
{
    if (! have) return test;
    ___ gchar* line_have = xml_node_attribute_lookup (have, "line");
    ___ gchar* line_test = xml_node_attribute_lookup (test, "line");
    ___ gchar* line_node = xml_node_attribute_lookup (test, "line");
    g_assert (line_have); g_assert (line_test); g_assert (line_node);
    ___ gchar* file_have = strchr (line_have, ' ');
    ___ gchar* file_test = strchr (line_test, ' ');
    ___ gchar* file_node = strchr (line_node, ' ');
    g_assert (file_have); g_assert (file_test); g_assert (file_node);
    if (_str_equal (file_node, file_test))
    
{
        /* it is in the same file - the old one is not */
        if (!_str_equal (file_node, file_have))
            return test;
        /* oops, two comments in the same file - take the latter */
        if (atoi (line_test) > atoi (line_have))
            return test;
        else
            return have;
    }
else if (_str_equal (file_node, file_have))
{
        /* the new one is not in this file - the old one is */
        return have;
    }
else
{
        /* otherwise, compare offsets in the textarray */
        if (test->off < node->off)
        
{
            if (node->off < have->off)
                return test;
            if (test->off < have->off)
                return have;
            else
                return test;
        }
else
{
            if (have->off < node->off)
                return have;
            if (test->off < have->off)
                return test;
            else
                return have;
        }
}
____;____;____;____;____;____; }
/*
   we scan the exports and comments and try to find a good match.
   Place a "forth_link" into the "comment" that points to the
   "forth_id" of the export that it most probably matches with,
   and a "forth_comment" into the export_line that carries the
   line-info where the comment happens to be.
 */
xml_GNode*
xml_pdoc_pfe_comment_link (xml_GNode* tree)
{
    xml_GList* list = xml_path_node_list (tree, "//item_cblock@forth_name");
    xml_GList* exports = xml_path_node_list (tree,"//export_line@forth_find");
    if (! list || ! exports) return tree;

    for (; exports; exports = xml_g_list_free_head (exports))
    
{
        xml_GList* item; xml_GNode* found = 0; gchar* name; gchar* line;
        name = xml_node_attribute_lookup (exports->data.node, "forth_find");
        g_assert (name);
        for (item = list; item; item = item->next)
        
{
            const gchar* test = 
                xml_node_attribute_lookup (item->data.node, "forth_name");
            g_assert (test);
            if (!strcmp (test, name))
            
{
                if (! found) 
                
{
                    found = item->data.node;
                }
else
{
                    found = better_match (
                        exports->data.node, found, item->data.node);
                }
}
}
if (found) goto _found; name = xml_node_attribute_lookup (exports->data.node, "forth_name"); line = xml_node_attribute_lookup (exports->data.node, "line"); g_assert (name); g_assert (line); for (item = list; item; item = item->next)
{
            const gchar* test = 
                xml_node_attribute_lookup (item->data.node, "forth_name");
            g_assert (test);
            if (!strcmp (test, name))
            
{
                if (! found) 
                
{
                    found = item->data.node;
                }
else
{
                    found = better_match (
                        exports->data.node, found, item->data.node);
                }
}
}
_found: if (! found) continue; xml_node_attribute_add (exports->data.node, "comment_line", xml_node_attribute_lookup (found, "line")); if (! xml_node_attribute_lookup (found, "forth_link"))
{
            xml_node_attribute_add (found, "forth_link", 
                xml_node_attribute_lookup (exports->data.node, "line"));
        }
else
{
            /* try to get a better_match */
        }
}
return tree; }
xml_GNode*
xml_pdoc_pfe_make_wordset_tree (xml_GNode* tree)
{
    if (0)
	return xml_pdoc_pfe_make_wordset_tree_1 (tree);
    else
	return xml_pdoc_pfe_make_wordset_tree_2 (tree);
}
/* ________________ wordsets_tree to docbook refentry pages _______________ */
void
xml_node_remove (xml_GNode* node)
{
    if (! node) return;
    node = xml_node_group_cut (node);
    /* g_printerr ("[%s]", node->name); */
    if (node) xml_g_node_destroy (node);
}
xml_GNode*
xml_path_remove_nodes (xml_GNode* tree, const gchar* xpath)
{
    xml_path_node_foreach (tree, xpath, (xml_GNodeForeachFunc)
			   xml_node_remove, 0);
    return tree;
}
xml_GNode*
xml_path_rename_nodes (xml_GNode* tree, const gchar* xpath, const gchar* name)
{
    xml_path_node_foreach (tree, xpath, (xml_GNodeForeachFunc)
			   xml_node_rename, (gpointer) name);
    return tree;
}
xml_GNode*
xml_node_rename_type (xml_GNode* tree, const gchar* name, const gchar* attr)
{
    if (! tree) return tree;
    ___ const gchar* value = tree->name;
    if (! attr) 
{ attr = value; value = ""; }
xml_node_attribute_add (tree, attr, value); ____; xml_node_rename (tree, name); return tree; }
xml_GNode* 
xml_node_rename_by_type (xml_GNode* tree, const gchar* name)
{ return xml_node_rename_type (tree, name, 0); }
xml_GNode*
xml_path_rename_nodes_by_type (xml_GNode* tree, const gchar* xpath, 
			       const gchar* name)
{
    xml_path_node_foreach (tree, xpath, (xml_GNodeForeachFunc)
			   xml_node_rename_by_type, (gpointer) name);
    return tree;
}
xml_GNode*
per_pfeworditem (xml_GNode* tree, gpointer data)
{
    xml_GNode* new1 = data;
    xml_GNode* pfeexport = xml_path_node (tree, "//pfeexport");
    xml_GNode* ref = xml_node_append (new1, "\n\n<refentry%p/\n", 
				      pfeexport ? pfeexport->attributes : 0);

    xml_node_append_copy (ref, tree, "\n");
    xml_path_remove_nodes (ref, "//br");
    xml_path_remove_nodes (ref, "//J");
    xml_path_rename_nodes_by_type (ref, "//forth_name", "function");
    xml_path_rename_nodes_by_type (ref, "//ccomment", "comment");
    xml_path_rename_nodes_by_type (ref, "//cliteral", "literal");
    xml_path_rename_nodes_by_type (ref, "//sliteral", "literal");
    return new1;
}
static const char doctype_docbook[] =
"<!DOCTYPE reference PUBLIC \"-//OASIS//DTD DocBook XML V4.1.2//EN\"\n"
"   \"http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd\">\n";
xml_GNode*
xml_pdoc_pfe_wordsets_2_words_reference (xml_GNode* tree, const char* title)
{
    xml_GNode* new1 = xml_tree_new (":", 0);
    if (! title) title = "Manual Pages";
    xml_node_append (new1, "<%#s/<reference/<title/%#s>", 
		     doctype_docbook, title);
    xml_path_node_foreach (tree, "//pfeworditem", (xml_GNodeForeachFunc)
			   per_pfeworditem, new1);
    return new1;
}
/* 
   Local variables:
   c-file-style: "stroustrup"
   End:
 */