#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:
 */