[% PROCESS 'perl_prog_tmpl.txt' %]=head1 NAME

[% NOM %]

=cut

package [% NOM %];

=head1 DESCRIPTION

Fill a template (based on the Perl Template Toolkit) with template
variables supplied in a syntax that supportes expansions known from
Makefiles written for GNU Make, read in from the commandline,
configuration files as well as (and mainly) makefile.

The syntax includes constructions like

    NAME1 := fixed value with variable components, in nice ${color} coloring
    FUNCTION1 = expandable value with parameters like ${1}, ${2} and ${3}
    NAME2 := $(call FUNCTION1,a,b,c)
    feast = let's feed the $(pl ${1}), $(pl ${2}) and other $(3 ${adj}) $(pl ${noun}) in ${locus}!
    _my_feast = $(fill feast,cat,dog,$(2|call|italic),$(adj||lovely),$(pl|call|plural),$(noun||pet),$(locus||my house))
    _your_feast = $(fill feast,tiger,crocodile,$(3|call|hyperref|${wildlife_url}),$(adj||wild),$(pl|call|plural),$(noun||beast),$(locus||your backyard))
    plural = ${1}s
    italic = <em>${1}</em>
    wildlife_url := http://en.wikipedia.org/wiki/Wildlife
    hyperref = <a href="${1}">${2}</a>
    include a2e/basic_template_variables.mk
    include a2e/important_template_variables.mk?+
    include a2e/unimportant_template_variables.mk?-
    include_re /opt/a2e/share/hanzi/toTW.dict \A\"(\S+)\"\t\"(\S+)\"\Z

Supported make functions/directives include

    call
    shell
    wildcard
    foreach
    ifdef
    ifndef
    ifeq
    basename
    notdir
    include
    export
    unexport

Some of these are extended, e.g. ifeq matches regular expressions and it accepts more than one argument

Additional functions help separate the different layers of text so as to reduce the costs of multilinguality.

  fill:  insert variables and functions into texts
  case:  define a simple array
  or:    logical or
  and:   logical and

Find explanations with

    perldoc A2E::SArb::Make(3)

Furthermore directives

  include_re:	include more vocabulary definitions using an alien syntax defined by a regex argument
  ifeq:	compare the first argument not only with a second one but with an unlimited list of further arguments, returning true if one matches
  ifneq: negation of ifeq 
  ifgt, iflt, ifge, ifle:  comparison functions greater_than, less_than, greater_or_equal, less_or_equal, working exactly like ifeq, i.e. returning true if comparison to any one of the subsequent arguments returns true
  ifset: like ifdef but true only if value is non-null in Perl sense
  ifnset: negation of ifset  
  ifeqs:	similar ifeq but evaluates arguments as a variable and compares it with values provided in following case statements, e.g.
	ifeqs styl
    	case dpat depat
        include dpat_lang.txt
        case |jpat.*|.*.ja.txt|
        include jpat_lang.txt
        case
        include pat_lang.txt
        endif

           with possible multiple regexps in each case statement and possibility to choose separator
           character by placing it at the beginning, e.g. '|' in this example, which prevents '.' from
           being interpreted as separator character.  ifeq works the same way, the use of ',' as
           separator character is, unlike in GNU Make, not obligatory.

  elif*:        alternative (C<else>) conditions can be specified; the if* loop ends after one of them was true
  special:	hook in external directives, e.g.

    	special = process bautext_tmpl.txt
        special = debug 1 tmplini
        special/non_debug/1/var:trivial
        special = debug_sarb 0
        special = miniverb u underline_verb
	special = alias tmpl oas_tra oas_akt_aammdd
	special = alias dok oal oas_akt1809
	special = alias tmplang deplate multemp
        special = miniverb c code_verb
        special:progvars:sems2subflat:sems2subtmpl# leave these variables to the program, disallow any further modification by the user from here on
        special|msg|the value of dd is %s but should be 01|${dd}|
        special|error|the value of dd is %s but should be 01|${dd}|
        special = antevars oas_varb_aamm tra,dd num # 'tra' and 'dd' must not be empty, 'num' may be empty
        special = litvalid tit # validate lit tit based on contents of lits tit_valids, tit_prompt, lenmax_errmsg etc
        special = setopt batch 1 # set a control variable stored in $m->{cache}
        special,nonnull,dd

    As shown in the examples, the argument is split by the first possible separator introduced by the user after the 'special' command.
 
New functions can be added by calling $m->{sarb}->add_renfun('name', sub { ... }), see A2E::SArb(3) and A2E::SArb::Make(3) for info.

Like in makefiles, there are two assignment statements, one with '=' for dynamic variables (i.e. functions), one with ':=' for static variables (strings).
Any dynamic variables that begin with '_' are expanded into static variables whose name does not have the initial '_' shortly before template processing begins; this is done by function render_dynaarbs.

The values of textchunks can represent multi-level list/hash structures, e.g.

   special = dabarel person |person:person|person:sig|persnom:tit|persdes:des|lok|rol|perstyp|realpsn|pass|mail|status|

The first encountered separator character is taken to represent the next-lower level.
Hashes are lists grouped into groups of three cells of which the first is null, the second is a (simple) key and the third is a potentially complex value.
They are recognised by the duplication of the initial separator, e.g. '||' und thus must start with separators.
C<special> commands that operate on hash strings are

	special = defhac
	special = hacputv
	special = dabarel

C<special> commands that operate on list strings are

	special = deflst    
	special = seqpuc
	special = tmplrels
        special = tmpltoks
	special = antevars

These commands parse the string into a tree using C<str2arb>, then perform an operation on that tree, and then again generate a string from that tree using C<arb2str>.  Since the resulting string uses the separators from C<arbseps> according to the resulting structure's hierarchy, it will greatly differ from any string that the user would produce on his own by simple concatenation.  Thus, when we treat strings as structures we prefer to use these commands.

By storing structures as strings we ensure that these structures can be transported in th SDBM database.
When a real list/hash reference is needed in a template, it can be produced on demand using the str2arb vmethod.

The 'include' syntax is like in Makefiles, with an INCLUDE_PATH that has Makefile-like defaults but can be changed via the tmplopts option.

This is a basic layer, on top of which other libraries like A2E::MLHT(3) and applications are built.

=head1 BUGS

Report to adv@a2e.de

=head1 VERSION

=over

=item 2010-04-20 version 0.2.0

Introduced groups and group-local definitions of string/list/hash variables.

=item 2010-03-29

Introduced str2arb, arb2str and their applications to support nexted list/hash structures represented as strings.
Certain kludgy mechanisms that were previously used, such as tmplhacs, will be abolished.

=item 2010-01-04 version 0.1.2

lots of changes and improvements.
introduced multidimensional hash variables as well as a few more 'special' verbs

=back

=cut

our $VERSION = '0.2.0';

=head1 LIMITATIONS

=head1 TODO

fix bugs, remove limitations

=head1 PREREQUISITES

=over

=item A2E::Prog(3)

=cut

use base 'A2E::TmplArb', 'A2E::Tmplkonf', 'A2E::Tmplvars';
use strict;use warnings 'all';no warnings 'uninitialized';
use File::Spec::Functions;
use List::MoreUtils qw(uniq);
use File::Basename;
use Scalar::Util qw(blessed);
use Data::Dumper;

=item Template(3)

=cut

$Template::BINMODE = ':utf8';use Template;

=item Template::Multilingual(3) etc

Use of these facilities, as well as of the A2E::Template::Plugin::MLHT plugin, is discontinued.
Instead the Make-like syntax with multilinguality supporting extensions provided by A2E::SArb::Make(3) should be used and extended.
Ultimately the set_template subroutine, which invokes various Template extensions, will probably be reduced to a simple invocation of Template.

=cut

use Text::Roman qw(roman);
use A2E::Template::Provider;
use A2E::Template::Context;
use A2E::Template::Directive;
use Template::Config;
use Template::Parser;
# $Template::Config::Provider = 'A2E::Template::Provider';
=item A2E::SArb::Make(3)

The workhorse of make-like macro expansion in lexical source files.

=cut

use A2E::SArb::Make;
use Encode qw(decode _utf8_on);

=back

=cut

our %MSGS = (
    pseudokond => 'ignoring would-be conditional conjunction %c',
    fprereq => 'file %f is already on the list of prerequisites, once is enough',
    setvarargs => 'upon setvar %n failed to apply %k to %A: %e',
    nofinklud => 'included file %f not found',
    fginklud => 'pseudo-including file %f in group %g with semi-implemented include syntax',
    nonnumsfx => 'numeral suffix %n is not numeral',
    nodefnlst => 'no definition list variable in %n',
    nonendef => 'endef is not ending any definition',
    topanon => 'anonymous group can not occur at top level',
    notmpl => 'current tmpl unknown',
    tavarstv => 'antevars inapplicable for template %t: %v',
    atmplvarv => '%a template variable %v',
    matchnovar => 'unknown match object variable %n',
    matchrnoval => 'unknown match regexp variable %n',
    matchvnoval => 'unknown match transformation verb variable %n',
    rnorx => 'unable to compile regexp from %r',
    l2vnefin => 'unassigned values %v remaining in lst2vars assignment',
    matchnefin => 'unassigned values %v remaining in match',
    nnolst => 'unable to convert variable %n to list: %m',
    nnolstv => 'unknown list variable %n',
    nnoval => 'no value for variable %n',
    nnovalv => 'unknown variable %n',
    fginclude => 'including file %f in group %g',
    ankvsnom => 'Anker %a deckt sich nicht mit Gruppennamen %n, Übergang in reine Org-Syntax?',
    evalbad => 'Sorry, I am unable to gather any content or structure from this string: %t',
    no_include_path => 'No include path where to search for file %f',
    context_no_sarb => 'no context sarb defined',
    bad_template => 'found bad template',
    bad_template_opts => 'generated bad template with options %O',
    new_template => 'unable to set template with options %O',
    exofls => 'in file %f line %l: %s',
    errflm => 'error in file %f line %l: %m',
    fgeof => 'encountering end of file %f inside group %g',
    gnehacr => 'local variable container %n is not a hashref',
    nogvar => 'no local %g variable defined for %n in %l',
    badref => 'reference variable %n should be of type %t but is of type %r', 
    nofbinpath => 'no file %b found in path %P',
    invexpfl => 'invalid include expression in file %f at line %l: %e',
    inkludfdko => 'included file %f not found in include path directories %D',
    inkludko => 'failed to include %i in %f at line %l: %m',
    frmnom => 'looking for possible default format info @%f',
    nogrupvar => 'no grup to search variable %n in', 
    finkloz => 'final content directive %n must be followed by closing bracket',
    notgrupopen => 'This line looks like but is not a group opening bracket: (%l%k',
    gnopars => 'nothing to parse for string %s in textchunk %n with attributes %l',
    nogruplini => 'gruplini without a group',
    litnom_p => 'user given identifiers like %k must never begin or end in _',
    setnusekt => 'attempting to make unnamed section the current one: %l',
    nusekt => 'attempting to store unnamed section as %n: %l',
    folinnfols => 'fol %f already in fols %F of %n',
    nolits => 'no lits variable available for internal variable %n with value %v',
    supnofols => 'upper node %s exists but has no __fols to push onto',
    badfrmer => 'invalid frmer %r in frml %t',
    glingruperef => 'in %n.glingrup __frm is an empty array reference',
    novarfrml => 'in %g.varfrm unknown formatter variable %f found in expression %e',
    nolstvarfrml => 'in %g.varfrm unknown formatter list variable %f found in expression %e',
    valfrmlexp => 'invalid format array expression %e',
    varfrmlarf => 'in %n.varfrm formatter variable %f has as value an invalid array expression %e',
    varfrmlnul => 'in %n.varfrm formatter variable %f given by expression %e refers to an empty array',
    frmlok => 'OK on frml %f',
    frmlnoref => 'in %n.glingrup __frm %f is not an array reference',
    gnofrml => 'no formatter found for group %g, not even default info @frm is available',
    nofrml => 'no formatter info given for document node %n',
    efrml => 'in %n empty formatter array reference frml %f',
    nfrml => 'in %n invalid formatter array reference frml %f',
    frml => 'in %n.subgrups unknown formatter array reference frml',
    nomlits => 'invalid property table of %n: %l',
    nomcirkl => 'You were about to open superior node %n once more and thus create an endless loop of nodes.',
    litudz => 'user-given text identifiers like %k must never end in number and underscore',
    lituaz => 'user-given identifiers like %k must never begin or end with an underscore',
    noreahac => 'not reassigning hash %n to %v',
    norealst => 'not reassigning list %n to %v',
    noovwra => 'ignoring attempt to overwrite antevars variable %n whose value is %v with new value %w',
    noovwrp => 'ignoring attempt to overwrite progvars variable %n whose value is %v with new value %w',
    sektnomnil => 'unnamed section at top level',
    nolitsfols => '__fols list not found at all, not even an empty one',
    regrup => 'about to open a group whose name %n already has a value %f' );

=head3 $arg = $m->valid_\w+($lihs,$arg,$vahr): validators
for use with A2E::TmplArb vlpuc, opuc, vopuc via $m->{var2validp}
=cut
sub valid_verb2fun {
    my ($m,$lihs,$verb) = @_;
    $m->pstop('attempting to retrieve special directive with invalid name %v', v => $verb) if $verb !~ m(\A\w+\Z);
    my $fun = $m->{tmplfil_special}->{$verb};
    $m->pstop('retrieved an invalid special directive %f for name %v', v => $verb, f => $fun) unless 'CODE' eq ref $fun;
    $fun;
}
=head4 $lstr = $m->valid_x2lstr($lihs,$elm): Coerce element or listref into listref
Return a listref in any case, similar to elm2list but for use in validators.
=cut
sub valid_x2lstr {
    my ($m,$lihs,$elm) = @_;
    my @list = $m->elm2list($elm);
    \@list;
}    
=head3 $ok = $m->tmplfil_defvars($lihs): initiate package A2E::Tmplfil
=cut
sub tmplfil_defvars {
    my ($m,$prog,$lihs) = shift->qlpuc('tmplfil_defvars',@_) or return;
    $m->tmplkonf_defvars($lihs);
    $m->tmplvars_defvars($lihs);
    $m->{var2validp}->{verb2fun} = \&valid_verb2fun;
    $m->{var2validp}->{x2lstr} = \&valid_x2lstr;
    my $verbose = $m->{cache}->{verbose} || '0';
    # 以下為實驗性、目前不始用 hacs, lsts, 見 file:/sig/oas/19/06/adv/_lng.oas_adv1906.txt::jung

=head1 OPTIONS

=head1 Object Variables

Some of these are used by upper libraries

=over

=item INTERFACE hashref tmplarbs

store for pre-compiled (tree-formed) template functions, passed to A2E::SArb object $m->{sarb} and used in there, especially by &A2E::SArb::getarb

=cut

    $m->{tmplarbs} = {};

=item hashrefs tmplhacs, tmpllsts

Cache for pre-compiled structured textchunks created with defhac and deflst respectively.
These variables can only be modified with special commands, all of which leave the current tree representation in the cache.
When variable values are not read from makefile source but from the dbm database, the cache records are created by the first invocation and reused thereafter.

=cut

=item lits: properties of the current group

Property tables of the current and other groups are stored in nom2lits.

=cut

    $m->{lits} = { __lvl => 0 };

=item nom2lits: table of groups

Table of tables of properties of groups, one for the absolute name of each textchunk variable that has group properties.

=cut

    $m->{nom2lits} = { };

=item hashref tmplxarbs
Cache for final variables generated with nom2xarbs, where the maketext references are stored by perl references.
This complicates programming: any function (such as defarb, lstpuc*, hacput*) that resets a structured value must delete its entry in tmplxarbs.
=cut
    $m->{tmplxarbs} = {};
=item tmplfuns
Store for ?additional? internal parsing functions, passed to A2E::SArb object $m->{sarb}, currently not used much.
=cut
    $m->{tmplfuns} = {};
=item hashref setvar_hooks

	setvar_hooks = hashref((varnom, listref(opts, kmdverb, kmdarg*)))

Indexed by the name of the variable upon whose setting a command is executed.
Each command consists of an options hashref, the special command verb and any initial argument.
These are registered by the special C<upon_setvars> and C<upon_setvar> directives.

=cut
    $m->{setvar_hooks} = {};
=item Conditional directives
=back
=item iflevel*

info stores for keeping track of conditional statements in textchunk files

=over
=item m_iflevel

current conditional level

=cut
    $m->{iflevel} = 0;
=item iflevel_komp

hash of values to which condition arguments are to be compared at each condition level

=cut
    $m->{iflevel_komp} = {};
=item iflevel_vals

hash of ternary values to which the last condition at each condition level evaluated.

  1: true
  0: false
 -1: no longer to be evaluated, e.g. because a previous condition was already true.

=cut
    $m->{iflevel_vals} = {};
=back

=head1 OPTIONS

The options of the prerequisite library A2E::Prog(3) are also available here.

=over

=item --tmplvars|--tv I<key>=I<val>

set a template variable

=cut

    $m->konfig_define(['tmplvars','tv'],'s%');

=item --tmplvars_string|--ts key1=val1,key2=val2,...

comma-separated list of template variable assignments in one argument

=cut

    $m->konfig_define(['tmplvars_string','ts'],'s');

=item --tmplvars_fayls|--tf I<files>

read variables from I<files>, where they are defined in Makefile-like syntax

=cut

    $m->konfig_define(['tmplvars_fayls','tf'],'@');

=item --setnomval '\A((?:export|unexport)\s+)?([@%]?\w+)\s+([?]?)([\-\+]?\:?)\=[\-\+]?\s+(.*)\s*\Z'

regular expression used for recognising assignment statements of all types.  Should resolve to

  $1 : 'export', 'unexport' or ''
  $2 : variable name
  $3 : '?' or null
  $4 : ':' or null
  $5 : variable value	

=cut

    $m->qre_define('setnomval', 's', '\A((?:export|unexport)\s+)?([@%]?[a-zA-Z][\w\.]*)\s+([?]?)([+-]?)([:]?)\=\s*(.*)\Z');
    $m->konfig_define('tabseps', '@', [ '|', '&' ]);
    $m->konfig_define('lvalnomp','s%', { tit => 1, sut => 1, des => 1,  lab => 1 });
    
=head1 CONFIGURATION FILE

The

	/etc/opt/a2e/tmplfil.konf
	~/tmplfil.konf
	@tmplfil

are read.  Moreover configuration files of the prerequisite libraries are inherited.

=cut

    $m->konfayl('tmplfil.konf');
=head1 MESSAGES

Translatable messages to be exported from variable %MSGS

=cut    
    $m->prog_msgdefs('tmplfil',%MSGS); #PROGDEFS
    $m->qpop1($prog,1);
};

=head1 IMPLEMENTATION

=head2 Overwritable Functions

The bulk of each function is forked out into a non-overwritable variant used for mix-in applications such as mlht(1)

=head3 Function defvars and forkout tmplfil_defvars

=cut

sub defvars {
    my ($m,$prog,$lihs) = shift->qlpuc('[% NOM %]::defvars', @_) or return;
    $m->SUPER::defvars($lihs);
    $m->tmplfil_defvars($lihs);
    $m->qpop1($prog,1);
};

=head4 ogpuc/tgpuc: extension of A2E::TmplArbs:opuc/tpuc for insering $gvars into arguments and %opts

Usage is like opuc/tpuc except that an additional $gvars hashref is inserted just before the regular arguments begin i.e. after $lihs/$optsr

=cut

sub ogpuc {
    my ($m,$prog,$lihs,$argsr,%opts) = shift->opuc0(@_);
    $opts{gvars} ||= $m->{grupvars};
    ($m,$prog,$lihs,$opts{gvars},@$argsr,%opts);
};
sub tgpuc {
    my ($m,$prog,$lihs,$optsr,@args) = shift->tpuc(@_);
    $optsr->{gvars} ||= $m->{grupvars};
    ($m,$prog,$lihs,$optsr,$optsr->{gvars},@args);
}

=head4 Function arb2xarb

Recursively expand the stored structure representation of a textchunk, such that any %hash, @list and $scalar references contained therein are replaced by references internally.
The thus expanded variable is not suitable for storage in the tmplhacs/tmplist caches and can not be converted back to its flattened string for storage in the tmplvars cache, but it can be used for internal operations.
Thus, the nom2xhac and nom2xlst functions use arb2xarb as a final expansion step in those variables that have been defined as expandable with defxhac, defxlst or the like.

	args := arb
	rets := xarb

=cut

sub strval_defarb { # former var2arb
    my ($m,$prog,$lihs,$typ,$nom,$lstr,%opts) = shift->lpuc('strval_defarb',@_);
    my ($str,$lvlmax) = eval { $m->str2str8lvlmax($lstr) };
    $m->pstop('cant set %n to %v: %s', n => $nom, v => $lstr, s => $@) if $@;
    my $arb = $m->defarb($lihs,$typ,$nom,$str,$lvlmax,%opts);
    $m->dpop1($prog,$arb);
}		

sub arb2xarb {
    my ($m,$prog,$arb,$lihs) = shift->ppuc('arb2xarb',@_);$lihs = $m->get_lihs($lihs);
    my $ref = ref $arb;
    my $xarb;
  REF: {
      do { $xarb = {};$xarb->{'_keys_'} = $arb->{'_keys_'};foreach my $nom (@{$arb->{'_keys_'}}) { $xarb->{$nom} = $m->arb2xarb($arb->{$nom},$lihs) };last } if 'HASH' eq $ref;
      do { $xarb = [];foreach my $elm (@$arb) { push @$xarb, $m->arb2xarb($elm,$lihs) };last } if 'ARRAY' eq $ref;
      my ($pfx, $nom) = $arb =~ m(\A([\%\@\$])(\w+)\Z);
      do { $xarb = $arb;last } unless $nom;
    PFX: {
	do { $xarb = $m->nom2hac($nom,$lihs);$m->ustop('hashvar %n not defined', n => $nom) unless $xarb;last } if $pfx eq '%';
	do { $xarb = $m->nom2lst($nom,$lihs);$m->ustop('listvar %n not defined, %s', n => $nom) unless $xarb;last } if $pfx eq '@';
	do { $xarb = $lihs->getstr($nom);$m->ustop('stringvar %n not defined', n => $nom) unless $xarb;last } if $pfx eq '$';
	$m->pstop('failed to parse %A in xarb', A => $arb);
      };
      last if $m->non_dynavar_p($nom);
      $xarb = $m->arb2xarb($xarb,$lihs);
    };
    $m->dpop1($prog,$xarb);
};    

=head3 Functions nom2hac, nom2lst, nom2xhac, nom2xlst

The normal way of invoking the unflattened value of a hash/list textchunk.
Take the variable from the tmplhacs cache if possible, otherwise (i.e. when using dbm files) store it there.
Ensure that a real hash/list reference is returned, fail otherwise.

    args := nom
    nom :: name of a hash/list variable
    nom => 'dabarels'
    rets := arb
    arb :: reference to the internal representation of the variable
    defhac:arb => { traprop => [ ... ], ... }
    deflst:arb => [ 'traprop', 'spez' ]	

While the C<nom2hac> and C<nom2lst> functions serve as subroutines for other functions within Tmplfil.pm, the C<nom2x*> functions are used externally, especially in invoking libraries such as A2E::Dokfs, A2E::MLHT, A2E::Mktdir and even, via a vmethod definition in A2E::MLHT, in TT Templates, where they make structured structured maketext variables available for Template processing, e.g. in nested iterations.
	    
=cut

sub __nom2arb__ ($$$$$;$) {
    my $m = shift;
    my $prog = shift;
    my $typ = shift;
    my $xpand = shift;
    $m->dpuc($prog, @_);
    my $nom = shift;
    $m->pstop('invalid nom %n', n => $nom) if ref $nom;
    my $lihs = $m->get_lihs(shift);
    my $treg = $lihs->treg($typ);
    my $arb = $lihs->{$treg}->{$nom};
    my $tref = $lihs->tref($typ);
    my $str = '';
  GET_ARB: {
      last if $arb;
      $str = $lihs->getstr($nom);
      $m->ustop('no such textchunk %n', n => $nom) if ! $str;
      $arb = $m->str2arb($str);
      if ($arb) {
	  $m->ustop('%n is not a %t variable', n => $nom, t => $tref) unless $tref eq ref $arb;
      } else {
	  $arb = 'HASH' eq $tref ? {} : [];
      };
    };
    $lihs->{$treg}->{$nom} = $arb;
    my $nondyn = 0;
  XARB: {
      last unless $xpand;
      $nondyn = $m->non_dynavar_p($nom);
      last if $nondyn;
      $arb = $m->{tmplxarbs}->{$nom} || $m->arb2xarb($arb,$lihs);
      $m->{tmplxarbs}->{$nom} = $arb;
    };
    $m->dpop1($prog,$arb);
};
sub nom2hac ($$;$) {
    my ($m,$nom,$lihs) = @_;
    $m->__nom2arb__('nom2hac', '%', 0, $nom, $lihs);
}
sub nom2lst ($$;$) {
    my ($m,$nom,$lihs) = @_;
    $m->__nom2arb__('nom2lst', '@', 0, $nom, $lihs);    
}
sub nom2xhac ($$;$) {
    my ($m,$nom,$lihs) = @_;
    $m->__nom2arb__('nom2xhac', '%', 1, $nom, $lihs);
}
sub nom2xlst ($$;$) {
    my ($m,$nom,$lihs) = @_;
    $m->__nom2arb__('nom2xlst', '@', 1, $nom, $lihs);    
}

=head3 Functions seqpucq, seqpucv, seqpuch, seqpucl, seqpucs, lstpucq, lstpucv, lstpuch, lstpucl, lstpucs

	arg1 $listnom: name of a list-like textchunk 
        arg2 $nurnov: whether to push a member only if it is new i.e. not yet in the list
        args3ff @noms: members to push

This is the basis of some 'special' commands like tmplrels and tmpltoks.

Variables:
    $lstnom: name of list, e.g. 'tmplrels'
    $lststr: current string representation of list, e.g. '|sdenom|sdedes|'
    $lstarb: tree representation of $lststr: [ 'sdenom', 'sdedes' ]
    @elmstrs: elements to be added, in string representation, e.g. 'traprop'   
    $elmstr: one of @elmstrs
    $elmarb: tree representation of $elmstr

Parameters:
        nurnov :: new only, refuse and warn about duplicates; check is only performed on string values including references
	eval_p :: evaluate the new member with str2arb and try to turn it into a structure, otherwise quote it verbatim

The C<lstpuc*> versions do not refuse duplicates.
Those that refuse duplicates are called C<seqpuc*> because a list without duplicates represents a sequence.
The final letters q (quoted), v (value), h (hashref), l (listref), s (stringref) have the same meaning and effects as in the hacput* functions.
         
	    
=cut

sub __lstpuc__ ($$$$$@) { 
    my $m = shift;
    my $prog = shift || '__lstpuc__';
    my $nurnov = shift;
    my $eval_p = shift;
    $m->dpuc($prog);
    my %opts = $m->ref2hash(shift);
    my $lihs = $m->get_lihs($opts{lihs});
    my $seplr = $opts{arbseps};
    my $nom = shift;
    $m->ustop('%n is not known as a list, use special deflst to define it', n => $nom) unless defined $lihs->{lsts}->{$nom};
    my $lst = $m->nom2lst($nom);
    my @strs = @_;
  MEMBER: foreach my $str (@strs) {
      my $arb = $eval_p ? $m->str2arb($str) : $str;
    NURNOV: {
	last if ref $arb;
	last unless grep { $_ eq $arb } @$lst;	
	$m->uwarn('request to add duplicate member %a to list %n is %(SW|granted|refused).', a => $arb, n => $nom, SW => $nurnov);
	next MEMBER if $nurnov;
      };
      push @$lst, $arb;
  };
    $lihs->{lsts}->{$nom} = $lst;
    delete $m->{tmplxarbs}->{$nom};
    my ($str,$lvlmax) = $m->arb2strl($lst,$seplr);
    $lvlmax ||= $lihs->{lvlmax}->{$nom};
    my $litstag = $m->pvar('litstag');
    $lihs->putstr($nom => $str, lvlmax => $lvlmax, litstag => $litstag, typ => 'd');
    $m->dpop1($prog,$str);
};
sub seqpucq {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('seqpucq',2,@_);my @vals = $m->elm2list($val);
    my $str = $m->__lstpuc__($prog, 1, 0, \%opts, $nom, @vals);
    $m->dpop1($prog,$str);
};
sub seqpucv ($$$%) {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('seqpucv',2,@_);my @vals = $m->elm2list($val);
    my $str = $m->__lstpuc__('seqpucv', 1, 1, \%opts, $nom, @vals);  
    $m->dpop1($prog,$str);
};
sub lstpucq ($$$%) {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('lstpucq',2,@_);my @vals = $m->elm2list($val);
    my $str = $m->__lstpuc__($prog, 0, 0, \%opts, $nom, @vals);
    $m->dpop1($prog,$str);
};
sub lstpucv ($$$%) {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('lstpucv',2,@_);my @vals = $m->elm2list($val);
    my $str = $m->__lstpuc__($prog, 0, 1, \%opts, $nom, @vals);
    $m->dpop1($prog,$str);
};

sub __lstpucx__ {
    my $m = shift;
    my $prog = shift; # 'seqpucl'
    my $pfx = shift; # '@'
    my $treg = shift; # 'lsts'
    my $typ = shift; # 'list'
    my $nurnov = shift; # 1
    $m->dpuc($prog, @_);
    my %opts = $m->ref2hash(shift); # (lihs => $lihs, arbseps => ['|','+'])
    my $lihs = $m->get_lihs($opts{lihs});
    my $arbnom = shift; # '__dabarels__'
    $m->pstop('%n is not a dynamic variable', n => $arbnom, t => $typ) if $m->non_dynavar_p($arbnom);
    my @varnoms = ();
    foreach my $varnom (@_) {
	$m->pstop('%n is not known as a variable of type %t', n => $varnom, t => $typ) unless $lihs->{$treg}->{$varnom};
	push @varnoms, $pfx . $varnom;
    };
    my $str = $m->__lstpuc__('',$nurnov,0,\%opts,$arbnom,@varnoms);
    $m->dpop1($prog,$str);
};
sub seqpuch {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('seqpuch',2,@_);
    $m->dpop1($prog,$m->__lstpucx__($prog, '%', 'hacs', 'hash', 1, \%opts, $nom, $val));
};
sub seqpucl {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('seqpucl',2,@_);
    $m->dpop1($prog,$m->__lstpucx__($prog, '@', 'lsts', 'list', 1, \%opts, $nom, $val));
};
sub seqpucs {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('seqpucs',2,@_);
    $m->dpop1($prog,$m->__lstpucx__('seqpucs', '$', 'vars', 'string', 1, \%opts, $nom, $val));
};
sub lstpuch {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('lstpuch',2,@_);
    $m->dpop1($prog,$m->__lstpucx__($prog, '%', 'hacs', 'hash', 0, \%opts, $nom, $val));
};
sub lstpucl {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('lstpucl',2,@_);
    $m->dpop1($prog,$m->__lstpucx__($prog, '@', 'lsts', 'list', 0, \%opts, $nom, $val));
};
sub lstpucs {
    my ($m, $prog, $lihs, $nom, $val, %opts) = shift->opuc('lstpucs',2,@_);
    $m->dpop1($prog,$m->__lstpucx__('lstpucs', '$', 'tmplvars', 'string', 0, \%opts, $nom, $val));
};

=head3 Functions hacputq, hacputv, hacputh, hacputl, hacputs

Set an element of a hash-like textchunk.

Invocation examples (of the corresponding C<special> directives):

    special = hacputq:progs:hello_world:Hello, my dear World!
    special = hacputv kolumn_lists spez spez,person,datum
    special = deflst spez_list spez,person,datum
    special = hacputl kolumn_lists spez spez_list
    special = hacputv kolumn_maps spez ||spez|transaction||person|user||datum|date|
    special = defhac spez_hash ||spez|transaction||person|user||datum|date|
    special = hacputh kolumn_maps spez spez_hash
    spez_name = transaction    
    special = hacputs kolumn_names spez spez_name

EBNF:

    args := hacnom, nom, val
    hacnom :: name of a hash variable
    nom :: hash key
    val :: hash value
    hacputq.val => 'Hello, my dear World!'
    hacputq.val :: string which is literally inserted into the $hacnom hash as value of $nom
    hacputv.val => '||a|1||b|2|'
    hacputv.val :: string which is parsed with str2arb and inserted as a tree structure (arb := hac || lst) if one is found
    hacputh.val => 'spez_hash'
    hacputh.val :: name of a hash defined with defhac or equivalent
    hacputl.val => 'spez_list'
    hacputl.val :: name of a list defined with deflst or equivalent
    hacputs.val :: 'spez_name'   
    hacputs.val :: name of a string variable defined by ordinary textchunk assignment or equivalent

The last three variants hacputh, hacputl and hacputs build a hash that references another variable and thus, when represented as a string, contains the reference whose type is indicated by a perlish special prefix C<%>, C<@> or C<$> as in

	%spez_hash
        @spez_list
	$spez_name	

The structure stored in the tmplhacs/tmpllsts cache also contains these references written in the same way. 
Expansion of these references takes place directly before use by the arb2xarb via the nom2xhac and nom2xlst functions, provided that the structured variable was defined as dynamic with defxhac or the like.

=cut

sub __hacput__ { 
    my $m = shift;
    my $prog = shift;
    my $eval_p = shift;
    $m->dpuc($prog, @_);
    my %opts = $m->ref2hash(shift);
    my $lihs = $m->get_lihs($opts{lihs});
    my $seplr = $opts{arbseps};
    my $hacnom = shift;
    $m->pstop('%n not known as hash, use defhac to register', n => $hacnom) unless $lihs->{hacs}->{$hacnom};
    my $hacarb = $m->nom2hac($hacnom);
    my @keys = @{$hacarb->{_keys_}};
    my %keysr = ();$keysr{$_} = 1 for @keys;
    while ($#_ > 0) {
	my $nom = shift;
	$m->ustop('hash index must be a string, not %n', n => $nom) if ref $nom;
	$m->vecho('hash index should be a symbol name, not %n', n => $nom) unless $nom =~ m(\A\w+\Z);
	my $val = shift;
	$val = $eval_p ? $m->str2arb($val) : $val;
	$hacarb->{$nom} = $val;
	do { $m->vecho('In hash %h overwritten old value of key %k', h => $hacnom, k => $nom);next } if $keysr{$nom};
	push @keys, $nom;
	$keysr{$nom} = 1;
    };
    @{$hacarb->{_keys_}} = @keys;
    $lihs->{hacs}->{$hacnom} = $hacarb;
    delete $m->{tmplxarbs}->{$hacnom};
    my ($hacstr,$lvlmax) = $m->arb2strl($hacarb,$seplr);
    my $litstag = $m->pvar('litstag');
    $lihs->putstr($hacnom => $hacstr, lvlmax => $lvlmax, litstag => $litstag, typ => 'd');
    $m->dpop1($prog, $hacstr);
};
sub hacputq { # literally quoted argument
    my ($m,$prog,$lihs,$hac,$k,$v,%opts) = shift->opuc('hacputq',3,@_);
    $m->dpop1($prog,$m->__hacput__($prog, 0, \%opts, $hac, $k, $v));
};
sub hacputv { # evaluated argument
    my ($m,$prog,$lihs,$hac,$k,$v,%opts) = shift->opuc('hacputv',3,@_);
    $m->dpop1($prog,$m->__hacput__($prog, 1, \%opts, $hac, $k, $v));
};

sub __hacputx__ {
    my $m = shift;
    my $prog = shift; # => 'hacputq'
    my $tpfx = shift; # => '@'
    my $treg = shift; # => 'lsts'
    my $type = shift; # 'english type name for messages' => 'list'
    $m->dpuc($prog, @_);
    my %opts = $m->ref2hash(shift); # (lihs => $lihs, arbseps => ['|', '+'])
    my $lihs = $m->get_lihs($opts{lihs});$opts{lihs} = $lihs;
    my $arbnom = shift; # => '__dabarel__'
    $m->pstop('%n is not a dynamic (type %t) variable', n => $arbnom, t => $type) if $m->non_dynavar_p($arbnom);
    my $nom = shift; # => 'tab'
    $m->pstop('%n is not a valid hash index name', n => $nom) unless $nom =~ m(\A\w+\Z);
    my $valnom = shift; # => '_dbr_spez_' ||  '+padr+person+adr+tel+url+'
    $m->pstop('%n is not known as a %t variable', n => $valnom, t => $type) unless $m->{lihs}->{$treg}->{$valnom};
    my $str = $m->hacputq($arbnom, $nom, $tpfx . $valnom, %opts);
    $m->dpop1($prog,$str);
};
sub hacputh {
    my ($m, $prog, $lihs, $hac, $k, $v, %opts) = shift->opuc('hacputh',3,@_);
    $m->__hacputx__($prog, '%', 'hacs', 'hash', \%opts, $hac, $k, $v);
};
sub hacputl {
    my ($m, $prog, $lihs, $hac, $k, $v, %opts) = shift->opuc('hacputl',3,@_);
    $m->__hacputx__($prog, '@', 'lsts', 'list', \%opts, $hac, $k, $v);
};
sub hacputs {
    my ($m, $prog, $lihs, $hac, $k, $v, %opts) = shift->opuc('hacputs',3,@_);
    $m->__hacputx__($prog, '$', 'vars', 'string', \%opts, $hac, $k, $v);
};

=head3 $ok = $m->dabarel($nom,$val,%opts{arbseps,lihs}): register a database relation

nom :: 'person'
val :: '|person+person|persnom+tit|persdes+L1|lok|rol|perstyp+typ|realpsn+real|pass|mail|status|'
opts.arbseps :: ['+','|']

The registered dabarel can then be connected to a document e.g. via tmplrels.

Store database relation info in the C<__dabarels__> hash.
To be used in maketext files by C<special dabarel> directive.

=cut

sub dabarel {
    my ($m,$prog,$lihs,$nom,$val,$seplr,%opts) = shift->opuc('dabarel',[[qw(nom text)],[qw(arbseps)],{ arbseps => 'lstr_let' }],@_);
    my $lstnom = '_'.'dbr'.'_'.$nom.'_';
    my @arbseps = eval { @$seplr };
    $m->pstop('bad arbseps option %a: %m', a => $seplr, m => $@) if $@;
    @arbseps = @{A2E::TmplArb::arbseps} unless @arbseps;
    $m->pstop('no arbseps available at all') unless @arbseps;
    $m->setlst($lstnom,$val,$lihs,\@arbseps);
    # $opts{arbseps} = $seplr if 'ARRAY' eq ref $seplr; # file:/phm/21/09/09/sig/_lng.phm_pub_sig210909.txt::arbseps
    # file:/phm/21/09/09/sig/_lng.phm_pub_sig210909.txt::arbseps
    my $sep = shift @arbseps;
    push @arbseps, $sep;
    $opts{arbseps} = \@arbseps; # file:/phm/21/09/15/sig/_lng.phm_pub_sig210915.txt::arbseps
    my $res = $m->hacputl('__dabarels__', $nom, $lstnom, %opts);
    $m->dpop1($prog,$res);
};

=head3 $m->tmplrels(@rels)

Add one or more rels (database relation aka table name which has been defined with C<special dabarel>) to _tmplrels_ (the list of dabarels to which document variables of the current template are written).
Check __dabarels__ (the internal hash in which all dabarels are registered) to ensure the added dabarel is valid. 

=cut

sub tmplrels {
    my ($m,$prog,$lihs,$rels) = shift->opuc('tmplrels',[qw(x2lstr)],@_);
    foreach my $rel (@$rels) {
	$m->ustop('relation %r not defined as dabarel', r => $rel) unless $lihs->{hacs}->{__dabarels__}->{$rel};
    };
    my $res = $m->seqpucq('_tmplrels_',$rels, lihs => $lihs);
    $m->dpop1($prog,$res);
};

=head3 Function sektrek


Associate a section name with a database relation, allowing subsections of this section to be treated as database records when so indicated in reksekts.

=cut

sub sektrek {
    my ($m,$prog,$lihs,$nom,$val,%opts) = shift->opuc('sektrek',[qw(nom text)],@_);
    my $lstnom = '_'.'skt'.'_'.$nom.'_';
    my $res = $m->setlst($lstnom, $val);
    $m->dpop1($prog,$res);
}

=head3 Function reksekts

State which section names should be treated as data record groups.
This may appear in a document or a template definition.

=cut

sub reksekts {
    my ($m,$prog,$lihs,$val,%opts) = shift->opuc('reksekts',1,@_);
    my $res = $m->setlst('_reksekts_',$val);
    $m->dpop1('reksekts', $res);
}


=head3 Function tmplfil_postkonfig

Here the work of reading makefiles into template variables is done.  Any application that inherits this library will have the template variables read in, based on configuration and commandline options, before the main program starts.

=cut

sub make_sarbfun {
    my ($m,$prog,$xnom,$xfun) = shift->ppuc('make_sarbfun',@_);
    my $fsub = sub {
	my $sarb = shift;$m->dpuc($xnom, @_);
	my $vars = shift;
	my $body = $sarb->render($vars, shift);
	$body = &$xfun($m, $body);
	return $m->dpop1($xnom,$body);
    };
    $m->dpop1($prog,$fsub);
}
sub sarb_addfun {
    my ($m,$prog,$nom,$fun) = shift->ppuc('sarb_addfun',@_);
    local $_ = $m->{sarb}->add_renfun($nom => $m->make_sarbfun($nom => $fun));
    $m->dpop1($prog,$_);
}
sub tmplfil_lihs_initvars {
    my ($m,$prog,$lihs) = shift->lpuc('tmplfil_lihs_initvars',@_);
    # file:/phm/18/10/15/sig/_lng.phm_pub_sig181015.txt::mv_initvars
    return $m->dpop($prog) if $lihs->{lsts}->{_tmplrels_};
    $m->defxhac($lihs,'__dabarels__');
    $m->deflst($lihs,'_antevars_' );
    $m->deflst($lihs,'_tmpltoks_');
    $m->deflst($lihs,'_reksekts_');
    $m->deflst($lihs,'_tmplrels_');
    $m->deflst($lihs,'include_extra');
    $m->dpop1($prog,1);
};
sub lihs_initvars {
    my ($m,$prog,$lihs) = shift->lpuc('A2E::Tmplfil::lihs_initvars',@_);
    $m->tmplfil_lihs_initvars($lihs);
    $m->dpop1($prog,1);
};

=head3 Functions lihs_new,lihs_old

Generate new A2E::Lihs object, restore previous one.

=head4 $ok = $m->tmplfil_postkonfig($lihs)

=head5 'special' commands and associated hash/list variables
=head5 special process

Process a TT Template 
	special process bautext_tmpl.txt
so as to make the block definitions found therein accessible for use from within maketext files:
	I quote as follows: $(proc:quote:Arma virumque cano ....)

=head5 special process

Begin/end debugging here.
If optional block names are given, debug only those block, else everything.
    
    args := flag, block*
    flag := boolean
    block :: a name of a block contained between dpuc and dpop statements

This works only if debugging is enabled -- which can be done by setting environment variable DEBUG_BLOKS to non-null.

=head5 special debug_sarb

begin/end debugging here.
    
    args := flag, block+
    flag := boolean
    block :: a name of a block contained between dpuc and dpop statements

=head5 tmpltoks

List structure extension of document metadata to include multilingual variants of certain non-document data.

This relies on a given mechanism of meta-documentation in the database involving the tables flddes which references deffld which references deftab which references klesi (class of tables).

Given the preparation

	a2e# insert into deffld values ( 'persnom', 'person', 't' ) ;
	INSERT 185793 1

and /adv/tmpl/a2e/lang_pre.txt

        special dabarel deprs |person:person|person:sde|persnom:sdenom|persdes:sdedes|lok:sdelok|rol:sderol|perstyp:sdetyp|realpsn:sdereal|pass:sdepass|mail:sdemail|status:sdesta|

something like 

	a2e# insert into flddes ( fld, lang, fldkey, fldval ) values ( 'persnom', 'zh', 'a2e', '亞通歐' ) ;
        INSERT 185794 1

is done by the program when in _lng.*.zh.txt statements like

	sde = a2e
	sdenom = 亞通歐

are found.

Not implemented yet.  (Really? pb150128: isn't it working in C</adv/tmpl/a2e/oas_akt_aammdd/lang.txt:special tmpltoks sdenom sdedes>?)
The idelits collection mechanism was supposed to make sure identifying lits/fields like sde/person are available when the data is to be written.
Not sure if it works at all as of 2017-01-29.
Some more reverse indexing needs to be done.

=head5 block debug_litnoms
store space-separated names given in environment variable DEBUG_LITNOMS into @{$m->{debug_litnoms}}
inform about values of these lits at various junctures in the program.

=cut

sub tmplfil_postkonfig {
    my ($m,$prog,$lihs) = shift->qlpuc('tmplfil_postkonfig',@_) or return;
    $m->tmplvars_postkonfig($lihs);
    my $tmplopts = $m->{cache}->{tmplopts};
    $tmplopts->{DEBUG} = $m->{DEBUG} ? 1 : 0;
    $m->{tmplfil_special} ||= {};
    $m->tmplfil_special_put(process => \&special_process);
    $m->tmplfil_special_put(debug => \&special_debug);
    $m->tmplfil_special_put(non_debug => sub { my $m = shift;$m->dpuc('special_non_debug', @_);my $flag = shift;$m->ustop('special directive non_debug invoked without initial 0/1 argument') unless $flag =~ m(\A[0,1]\Z);my @bloks = @_;if (@bloks) { foreach my $blok (@bloks) { $m->{non_debug_bloks}->{$blok} = $flag } };my $res = { flag => $flag, bloks => \@bloks };$m->dpop1('special_non_debug', $res) });
    $m->tmplfil_special_put(upon_setvar => \&upon_setvar);
    $m->tmplfil_special_put(upon_setvars => \&upon_setvars);
    $lihs->{vars}->{$_} = $m->{konfig}->tmplvars->{$_} for keys %{$m->{konfig}->tmplvars};
  TMPLVARS: {
      my $s = $m->{konfig}->tmplvars_string;
      last unless defined $s;
      my @vars = split ',', $s;
      my ($key, $val) = ();
      foreach my $var (@vars) {
	  ($key, $val) = split '=', $var;
	  $lihs->putstr($key => $val);
      };
    };
    $m->{sarb}->{debug_bloks} = $m->{debug_bloks};
    $m->tmplfil_special_put(debug_sarb => sub { my $m = shift;my $flag = shift;$m->ustop('special directive debug_sarb invoked without initial 0/1 argument') unless $flag =~ m(\A[0,1]\Z);my @bloks = @_;if (@bloks) { foreach my $blok (@bloks) { $m->{sarb}->{debug_bloks}->{$blok} = $flag } } else { $m->{sarb}->{DEBUG} = $flag };{ flag => $flag, bloks => \@bloks } } );
    $m->tmplfil_special_put(non_debug_sarb => sub { my $m = shift;$m->dpuc('special_non_debug_sarb', @_);my $flag = shift;$m->ustop('special directive non_debug_sarb invoked without initial 0/1 argument') unless $flag =~ m(\A[0,1]\Z);my @bloks = @_;if (@bloks) { foreach my $blok (@bloks) { $m->{sarb}->{non_debug_bloks}->{$blok} = $flag } } else { $m->{sarb}->{nodebug} = $flag };my $res = { flag => $flag, bloks => \@bloks };$m->dpop1('special_non_debug_sarb', $res) });
    $m->tmplfil_special_put(miniverb => sub { my $m = shift;return $m->{sarb}->miniverb_put(@_) });
    $m->tmplfil_special_put(sfx2fun => sub { my $m = shift;my $lihs = $m->get_lihs;my $sup = $m->{lits}->{__nom};return unless $sup;@_ = map { $m->setvfol($_,$sup, lihs => $lihs) } @_;scalar @_ });
    $m->tmplfil_special_put(jungils => sub { my $m = shift;
					 my $nom = $m->{lits}->{__nom};
					 $m->pstop('special jungils must be invoked from within a grup') unless $nom;
					 my $frmt = $m->grupopen_pars_frm(shift);
					 $m->grupopen_stor_frm($nom,$frmt);
					 return $frmt } );
    $m->tmplfil_special_put(progvars => sub { my $m = shift;foreach my $var (@_) { $m->{progvars}->{$var} = $lihs->getarb($var) } });
    $m->tmplfil_special_put(alias => sub { my ($m,$var,$alias,$real) = @_;$m->set_ali2val($var,$alias,$real) });
    $m->tmplfil_special_put(echo => sub { my ($m,@args) = @_;$m->echo(1, map { $m->grupfill($_) } @args);scalar @args });
    $m->tmplfil_special_put(error => sub { my $m = shift;$m->ustop(map { $m->grupfill($_) } @_) });
    $m->tmplfil_special_put(nonnull => sub { my $m = shift;foreach my $nom (@_) { my $val = $lihs->getstr($nom);$m->ustop('variable %n must not be empty', n => $nom) unless $val };scalar @_ });
    $m->tmplfil_special_put(begin => sub { 
	my ($m,@tags) = @_;my $lihs = $m->get_lihs;
	my $flag = '__'. join '_', @tags;
	$lihs->{vars}->{$flag} = 1;
	1 } );
    $m->tmplfil_special_put(end => sub { 
	my ($m,@tags) = @_;my $lihs = $m->get_lihs;
	my $flag = '__'. join '_', @tags;
	$lihs->{vars}->{$flag} = 0;
	1 } );
    $m->tmplfil_special_put(antevars => sub { my ($m,@args) = @_;$m->antevars(undef,@args) }) ;
    $m->tmplfil_special_put(tmpl_antevars => sub { my ($m,@args) = @_;$m->tmpl_antevars(undef,@args) });
    $m->tmplfil_special_put(deflst => sub { my ($m,$nom,$val) = @_;$m->deflst(undef,$nom,$val) });
    $m->tmplfil_special_put(defhac => sub { my ($m,$nom,$val) = @_;$m->deflst(undef,$nom,$val) });
    $m->tmplfil_special_put(setlst => sub { my ($m,$nom,$val) = @_;$m->setlst($nom,$val) });
    $m->tmplfil_special_put(sethac => sub { my ($m,$nom,$val) = @_;$m->sethac($nom,$val) });
    $m->tmplfil_special_put(setxlst => sub { my ($m,$nom,$val) = @_;$m->setxlst($nom,$val) });
    $m->tmplfil_special_put(setxhac => sub { my ($m,$nom,$val) = @_;$m->setxhac($nom,$val) });
    $m->tmplfil_special_put(defxlst => sub { my ($m,$nom,$val) = @_;$m->defxlst(undef,$nom,$val) });
    $m->tmplfil_special_put(defxhac => sub { my ($m,$nom,$val) = @_;$m->defxhac(undef,$nom,$val) });
    $m->tmplfil_special_put(seqpucq => sub { my ($m,$nom,@vals) = @_;$m->seqpucq($nom,\@vals) });
    $m->tmplfil_special_put(seqpucv => sub { my ($m,$nom,@vals) = @_;$m->seqpucv($nom,\@vals) });
    $m->tmplfil_special_put(seqpuch => sub { my ($m,$nom,@vals) = @_;$m->seqpuch($nom,\@vals) });
    $m->tmplfil_special_put(seqpucl => sub { my ($m,$nom,@vals) = @_;$m->seqpucl($nom,\@vals) });
    $m->tmplfil_special_put(seqpucs => sub { my ($m,$nom,@vals) = @_;$m->seqpucs($nom,\@vals) });
    $m->tmplfil_special_put(lstpucq => sub { my ($m,$nom,@vals) = @_;$m->lstpucq($nom,\@vals) });
    $m->tmplfil_special_put(lstpucv => sub { my ($m,$nom,@vals) = @_;$m->lstpucv($nom,\@vals) });
    $m->tmplfil_special_put(lstpuch => sub { my ($m,$nom,@vals) = @_;$m->lstpuch($nom,\@vals) });
    $m->tmplfil_special_put(lstpucl => sub { my ($m,$nom,@vals) = @_;$m->lstpucl($nom,\@vals) });
    $m->tmplfil_special_put(lstpucs => sub { my ($m,$nom,@vals) = @_;$m->lstpucs($nom,\@vals) });
    $m->tmplfil_special_put(hacputq => sub { my ($m,$nom,$k,$v) = @_;$m->hacputq($nom,$k,$v) }); 
    $m->tmplfil_special_put(hacputv => sub { my ($m,$nom,$k,$v) = @_;$m->hacputv($nom,$k,$v) }); 
    $m->tmplfil_special_put(hacputh => sub { my ($m,$nom,$k,$v) = @_;$m->hacputh($nom,$k,$v) }); 
    $m->tmplfil_special_put(hacputl => sub { my ($m,$nom,$k,$v) = @_;$m->hacputl($nom,$k,$v) }); 
    $m->tmplfil_special_put(hacputs => sub { my ($m,$nom,$k,$v) = @_;$m->hacputs($nom,$k,$v) }); 
    $m->tmplfil_special_put(dabarel => sub { my ($m,$k,$v) = @_;$m->dabarel($k,$v) }); 
    $m->tmplfil_special_put(sektrek => sub { my ($m,$k,$v) = @_;$m->sektrek($k,$v) });
    $m->tmplfil_special_put(reksekts => sub { my ($m,$val) = @_;$m->reksekts($val) }); 
    $m->tmplfil_special_put(tmplrels => sub { my ($m,$val) = @_;$m->tmplrels($val) });
    $m->tmplfil_special_put(tmpltoks => sub { my ($m,@vals) = @_;$m->seqpucq('_tmpltoks_', \@vals) });
    $m->tmplfil_special_put(setopt => sub { my $m = shift;$m->dpuc('setopt', @_);my $nom = shift;my $val = shift;$m->ustop('no such option %n', n => $nom) unless defined $m->{cache}->{$nom};$m->{cache}->{$nom} = $val;$m->dpop1('setopt', $val) });
    $m->tmplfil_special_put(upon_setvar => sub { shift->upon_setvar(@_) });
    $m->tmplfil_special_put(upon_setvars => sub { shift->upon_setvars(@_) });
    $m->set_template_include_path unless $tmplopts->{INCLUDE_PATH}; 
    $m->{tmplfil_kompopfuns} = { eq => sub { $_[0] eq $_[1] }, neq => sub { $_[0] ne $_[1] }, lt => sub { $_[0] < $_[1] }, gt => sub { $_[0] > $_[1] }, le => sub { $_[0] <= $_[1] }, ge => sub { $_[0] >= $_[1] } };$m->{tmplfin_kompopfuns}->{ne} = $m->{tmplfin_kompopfuns}->{neq};
    $m->{kompar_match} = sub { my ($arg, $komp) = @_;$arg =~ m(\A$komp\Z) };
    $m->{kompar_equal} = sub { my ($arg, $komp) = @_;$arg eq $komp };
    my $render_match = sub {
	# hodie = 2018-10-08
	# datum_regex = \A(d{4})\-(\d{2})\-(\d{2})\Z
        # match_ok = $(match|hodie|datum_regex|aaaa|mm|dd)
	my $sarb = shift;
	my $lihs = $sarb->{lihs};
	my $vars = shift;
	my $nom = $sarb->render($vars, shift);
	local $_ = $lihs->getstr($nom) || $m->ustop(matchnovar => n => $nom);
	$nom = $sarb->render($vars, shift);
	my $srxp = $lihs->getstr($nom) || $m->ustop(matchrnoval => n => $nom);
	my $rxp = qr($srxp) || $m->ustop(rnorx => r => $srxp);
	my @vals = m($rxp);
	my ($val);
	my $litstag = $m->pvar('litstag');
	while (@_) {
	    $nom = $sarb->render($vars,shift);
	    $val = shift @vals;
	    do { $m->uwarn(nnoval => n => $nom);last } unless $val;
	    $lihs->putstr($nom => $val, litstag => $litstag, typ => 'd');
	};
	do { $m->uwarn(matchnefin => v => $m->koniug_et(@vals));return } if @vals;
	$m->arb2str(\@vals);
    };
    my $render_rxvok = sub {
	# hodie = 2018-10-08
	# datum_regex = \A(d{4})\-(\d{2})\-(\d{2})\Z
	# datum_verb = '${1}年${2}月${3}日'
        # DATUM := $(rxvok|datum_regex|datum_verb|${hodie})
	# 前二者被視為動詞之延伸故為變量
	my $sarb = shift;
	my $lihs = $sarb->{lihs};
	my $vars = shift;
	my $nom = $sarb->render($vars, shift);
	my $srx = $lihs->getstr($nom) or $m->ustop(matchrnoval => n => $nom);
	my $qrx = qr($srx) or $m->ustop(rnorx => r => $srx);
	$nom = $sarb->render($vars, shift);
	my $vok = $lihs->getstr($nom) or $m->ustop(matchvnoval => n => $nom);
	local $_ = $sarb->render($vars, shift);
	my @vals = m($qrx);
	return unless @vals;
	my $val = $sarb->val_args_call($vok, $vars, @vals);
	return $val;
    };
    my $render_lst2vars = sub {
	# |lst2vars|amdl|aaaa|mm|dd|, where amdl is a name of an existing list variable, whose elements are then assigned to aaaa, mm and dd.
	my $sarb = shift;
	my $lihs = $sarb->{lihs};
	my $vars = shift;
	my $nom = $sarb->render($vars, shift);
	my $val = $lihs->getstr($nom) || $m->ustop(nnovalv => n => $nom);
	my $arb = $lihs->getlstr($nom) || $m->ustop(nnolstv => n => $nom);
	my @vals = eval { @$arb };
	$m->ustop(nnolst => n => $nom, m => $@) if $@;
	my $litstag = $m->pvar(litstag => 1);
	while (@_) {
	    $nom = $sarb->render($vars,shift);
	    $val = shift @vals;
	    do { $m->uwarn(nnoval => n => $nom);last } unless $val;
	    $lihs->putstr($nom => $val, litstag => $litstag, typ => 'd');
	};
	$m->uwarn(l2vnefin => v => $m->koniug_et(@vals));
	return $m->arb2str($arb);
    };
    my $render_slv = sub {
	my $sarb = shift;
	my $lihs = $sarb->{lihs};
	my $vars = shift;
	my @slngs = $m->grupvars_getlst($lihs,'slngs');
	my $lang = $m->pval(lang => 1);
	my ($val,$lval) = ('','');
	foreach my $lng (@slngs) {
	    $val = shift;
	    next unless $lng eq $lang;
	    $lval = $sarb->render($vars, $val);
	    last;
	};
	return $lval;
    };
    my $render_assoc = sub { #  |assoc|fol|_antevars|
	my $sarb = shift;
	my $lihs = $sarb->{lihs};
	my $vars = shift;
	my $key = $sarb->render($vars, shift);
	$m->ustop('invalid assoc key %k', k => $key) unless $key =~ m(\A\w+\Z);
	my $var = $sarb->render($vars, shift);
	my $val = $lihs->getstr($var);
	$m->ustop('no such variable %v', v => $var) unless $val;
	$val = $lihs->{hacs}->{$var} || $m->str2arb($val);
	$m->ustop('no such hash variable %v', v => $var) unless 'HASH' eq ref $val;
	$lihs->{hacs}->{$var} ||= $val;
	$val->{$key} };
    $m->{sarb}->add_renfun(match => $render_match);
    $m->{sarb}->add_renfun(rxvok => $render_rxvok);
    $m->{sarb}->add_renfun(slv => $render_slv);
    $m->{sarb}->add_renfun(lst2vars => $render_lst2vars);
    $m->sarb_addfun(slv => $render_slv);
    $m->{sarb}->add_renfun(assoc => $render_assoc);
    $m->sarb_addfun(romnum => \&romnum);
    $m->sarb_addfun(num2alpha => \&num2alpha);
    $m->sarb_addfun(num2Alpha => \&num2Alpha);
    $m->riid_tmplvars_fayl($_) for @{$m->{konfig}->tmplvars_fayls};
  DEBUG_LITNOMS: {
      my $litnoms_s = $ENV{DEBUG_LITNOMS};
      last unless $litnoms_s;
      my @litnoms_l = split m(\s+), $litnoms_s;
      last unless @litnoms_l;
      $m->{debug_litnoms} = [ @litnoms_l ];
    };
    $m->{lihs} ||= $lihs; 
    $m->lihs_initvars($lihs); # still needed because get_lihs from lowest level may be used during bootstrapping
    $lihs->setdir($m->get_cwd);
    $m->qpop1($prog,1);
};

=head3 Special directive function upon_setvar

Register a hook, i.e. a commandline, including expandable maketext expressions, that will be executed after the variable is written.

	args := varnom, kmdverb, *kmdarg
	varnom :: name of variable on whose resetting the command will be executed
	kmdverb :: special directive to invoke
        *kmdarg :: arguments which will be maketext-evaluated and passed to kmdverb
	rets := ok
    	ok :: If true, the hook will be removed, otherwise it will stay and a warning will be issued.

The use of this information happens in the C<setvar_hooks> block of function C<tmplini>.

=cut

sub __upon_setvar__ {
    my $m = shift;
    my $fun = shift;
    my $singul = shift;
    $m->dpuc($fun, @_);
    my $varnom = shift;
    my $kmdverb = shift;
    $m->pstop('%f %n: special directive %k not known', f => $fun, n => $varnom, k => $kmdverb) unless $m->{tmplfil_special}->{$kmdverb};
    my @kmdargs = @_;
    $m->{setvar_hooks}->{$varnom} ||= [];
    push @{$m->{setvar_hooks}->{$varnom}}, [ { singul => $singul }, $kmdverb, @kmdargs ];
    $m->dpop1($fun, $varnom);
};
sub upon_setvar {
    return shift->__upon_setvar__('upon_setvar', 1, @_);
}
sub special_debug { 
    my $m = shift;
    $m->dpuc('special_debug', @_);
    my $flag = shift;
    $m->ustop('special debug invoked without initial 0/1 argument') unless $flag =~ m(\A[0,1]\Z);
    my @bloks = @_;
    if (@bloks) { foreach my $blok (@bloks) { $m->{debug_bloks}->{$blok} = $flag } } else { $m->{DEBUG} = $flag };
    my $res = { flag => $flag, bloks => \@bloks };
    $m->dpop1('special_debug', $res);
};
sub special_process { 
    my $prog = 'special_process';my $m = shift;$m->dpuc($prog,@_);
    my $block = shift;
    my %params = @_;
    $m->{template}->process($block, \%params);
    $m->pstop($m->{template}->error()) if $@;
    my $res = { block => $block, params => \%params };
    $m->dpop1($prog,$res);
};
sub upon_setvars {
    return shift->__upon_setvar__('upon_setvars', 0, @_);
}



=head3 $m->antevars(\@primnoms,@restnoms) => \@antevars

Arguments divided into one argument, consisting of a list of primnoms (primary names) which must be known and nonnull already, and the remaining arguments, restnoms, which are written into the configuration file antefayl0 even with null values

set antevars only if we are in the right template, i.e between a pair of

	special begin tmpl $tmpl_name
	special end tmpl $tmpl_name

where $tmpl_name is the current document's template.

=cut

sub antevars { 
    my ($m,$prog,$lihs,$primnomsr,@restnoms) = shift->lpuc('antevars',@_);my @primnoms = $m->textsep2list($primnomsr);
    my $chk_noms = sub { # 190818 no longer usable since we have different $lihs objects
	foreach my $nom (@primnoms) {
	    next unless $nom;
	    next if defined $lihs->getstr($nom);
	    $m->ustop(atmplvarv => a => do { if (not exists $lihs->{vars}->{$nom}) { 'inexistent' } elsif (not defined $m->{lihs}->{vars}->{$nom}) { 'undefined' } else { 'empty' } }, v => $nom ); # stop_atmplvarv
	};
    };
    # &$chk_noms;
    $m->uniqpush($lihs->{lsts}->{_antevars_},\@primnoms,\@restnoms);
    $lihs->{hacs}->{_antevarp_}->{$_} = 1 for @{$lihs->{lsts}->{_antevars_}};
    $m->dpop1($prog,$lihs->{lsts}->{_antevars_});
};
sub tmpl_antevars {
    my ($m,$prog,$lihs,@args) = shift->lpuc('tmpl_antevars',@_);
    my $tmpl = $lihs->{vars}->{tmpl} || $m->pvar(__tmpl => 0) || $m->pvar(tmpl => 0);
    $m->ustop(notmpl => undef) unless $tmpl;
    return $m->Wpop0($prog, v => tavarstv => t => $tmpl, v => \@args) if !$lihs->{vars}->{'__tmpl_'.$tmpl};
    my $res = $m->antevars($lihs,@args);
    $m->dpop1($prog,$res);
};

=head3 Function riid_tmplvars_init

Initiations to be performed directly before reading textchunk files.

The list/hash definitions may not be done in initialisation as that would prevent those programs that rely on dbm only from parsing their flattened representations with nom2hac/nom2lst.

=cut

sub riid_tmplvars_init {
    my ($m,$prog,$lihs,$initvars) = shift->opuc('riid_tmplvars_init',1,@_);$initvars ||= $m->{progvars};
  INITVARS: {
      # 曽試廢而復: file:/phm/18/10/15/sig/_lng.phm_pub_sig181015.txt::rm_initvars
      $initvars->{$_} = $m->pvar($_) for qw(hodie); # 190817 廢tmpl
      foreach my $nom (keys %$initvars) {
	  my $val = $initvars->{$nom};
	  next unless $val;
	  $m->lihs_putarb($lihs,$nom => $val);
	  $m->lihs_putarb($lihs,'__'.$nom => $val); # 或許可廢、progvars已受足保護
      };
    };
    local $_ = $m->pvar(hodie => 1); # || strftime '%Y-%m-%d', $m->plst(progtime => 1);
    my @aamd = m(\A(\d{2}(\d{2}))\-(\d{2})\-(\d{2})\Z);
    $m->ustop('date hodie %h in incorrect format', h => $_) unless @aamd;
    $lihs->putstr(__aaaa => shift @aamd, typ => 'i');
    $lihs->putstr(__aa => shift @aamd, typ => 'i');
    $lihs->putstr(__mm => shift @aamd, typ => 'i');
    $lihs->putstr(__dd => shift @aamd, typ => 'i' );
    my (@wwd) = split /\s+/, $m->{sarb}->render_strfamd({}, '%W %w', @aamd[0,2,3]);
    $wwd[1] ||= '7'; # sunday expressed as 7 rather than 0
    $m->ustop('cant obtain weekday info %W from date %A', W => \@wwd, A => $m->koniug_et(@aamd[0,2,3])) unless @wwd;
    $lihs->putstr(__ww => shift @wwd, typ => 'i');
    $lihs->putstr(__wd => shift @wwd, typ => 'i');
  NO_DEL: {
      last;
      foreach my $nom (keys %{$m->{lihs}->{hacs}}, keys %{$m->{lihs}->{lsts}}, qw(_antevars_ __dabarels__ _reksekts_ _tmpltoks_ _tmplrels_)) { delete $lihs->{vars}->{$nom} }; 
      %{$m->{lihs}->{hacs}} = ();
      %{$m->{lihs}->{lsts}} = ();
      # 似已無需大幅刪除 file:/phm/18/10/15/sig/_lng.phm_pub_sig181015.txt::no_del
      # 遷移變量: file:/phm/18/10/15/sig/_lng.phm_pub_sig181015.txt::mv_initvars
    };
    $m->dpop1($prog,1);
};

=head3 Function riid_tmplvars_post

Overwrite to add hook

=cut

sub riid_tmplvars_post {
    my ($m,$prog) = shift->ppuc('[% NOM %]::riid_tmplvars_post',@_);
    $m->dpop1($prog,1);    
};

=head3 Function postkonfig

Wrapper around tmplfil_postkonfig for automatic use in A2E::Prog::new_ready constructor mechanism.

=cut

sub postkonfig {
    my ($m,$prog) = shift->qpuc('[% NOM %]::postkonfig', @_) or return;
    $m->SUPER::postkonfig;
    $m->tmplfil_postkonfig;
    $m->qpop1($prog,1);
};

=head3 Function tmplopts

Return a hash consisting of a subset of valid options obtained from configuration variable tmplopts, based on keys supplied as args

=cut

sub tmplopts {
    my $m = shift;
    my $opts = {};
    my @noms = @_;
    my $tmplopts = $m->{cache}->{tmplopts};
  NOMS: {
      last unless @noms;
      my $nom = shift @noms;
    EVAL_PERL: {
	last unless $nom eq 'EVAL_PERL';
	last unless $opts->{$nom};
	last if $m->superuserp;
	$m->uwarn('Refusing for security reasons to set tmplopts EVAL_PERL to %v.', v => $opts->{$nom});
	redo NOMS;
      };
      $opts->{$nom} = $tmplopts->{$nom};
      redo NOMS;
    };
    return $opts;
};

=head3 Function set_template

Prepare the template.

=cut

sub set_template {
    my ($m,$prog,$lihs,$tmplang,$tmpl) = shift->lpuc('set_template',@_);
    $tmplang ||= $m->pvar('tmplang');
    $tmpl ||= $m->pvar('tmpl');
    my $template = $m->{ttt2template}->{$tmplang.'_'.$tmpl};
  FOUND: {
      last unless $template;
      $m->pstop(bad_template => 0) unless 'Template' eq ref $template;
      $m->{template} = $template;
      return $m->dpop1($prog,$template);
    };
    my $path = $m->set_template_include_path(tmpl => $tmpl, tmplang => $tmplang, lihs => $lihs);
    # $m->pstop('sarb not found') unless $m->{sarb};
    # $m->pstop('sarb is not a A2E:SArb::Make') unless blessed($m->{sarb}) eq 'A2E::SArb::Make';
    # $m->pstop('sarb vars are not tmplvars') unless $m->{sarb}->{vars} eq $m->{lihs}->{vars};
    my $opts = $m->tmplopts(qw(INCLUDE_PATH INTERPOLATE ENCODING DEBUG FACTORY RELATIVE ABSOLUTE EVAL_PERL));
    $m->{cache}->{tmplopts}->{PARSER} = new Template::Parser $opts or $m->pstop('unable to set parser with options %O', O => $opts);
    $opts->{PARSER} = $m->{cache}->{tmplopts}->{PARSER};
    my $provider = new A2E::Template::Provider $opts or $m->pstop('unable to set provider with options %O', O => $opts);
    $m->{cache}->{tmplopts}->{LOAD_TEMPLATES} = [ $provider ];
    $opts = $m->tmplopts(qw(INCLUDE_PATH LOAD_TEMPLATES EVAL_PERL PLUGIN_BASE DEBUG RELATIVE ABSOLUTE));
    $m->{cache}->{tmplopts}->{CONTEXT} = new_ready A2E::Template::Context $opts, $m->{sarb} or $m->pstop('unable to set context with options %O', O => $opts);
    # Template::Manual::Config http://template-toolkit.org/docs/manual/Config.html#section_VARIABLES
    $m->{cache}->{tmplopts}->{NAMESPACE} = { prog => $m->{progvars} };
    $m->{cache}->{tmplopts}->{DEBUG_ALL} = $m->{debug};
    $m->{cache}->{tmplopts}->{COMPILE_EXT} = '.ttc';
    $m->{cache}->{tmplopts}->{ABSOLUTE} = 1;
    $m->{cache}->{tmplopts}->{RELATIVE} = 1;
    $m->{cache}->{tmplopts}->{STRICT} = 0; # TODO set to 1 for better debugging ASAP
    $m->{cache}->{tmplopts}->{COMPILE_DIR} = '/adv/tmpl/ttc';
    use Template::Namespace::Constants;
    $m->{cache}->{tmplopts}->{NAMESPACE} = { 
	__vars__ => Template::Namespace::Constants->new($lihs->{vars}),
	__lsts__ => Template::Namespace::Constants->new($lihs->{lsts}),
	__hacs__ => Template::Namespace::Constants->new($lihs->{hacs}) }; 
    $opts = $m->tmplopts(qw(INCLUDE_PATH LOAD_TEMPLATES TAG_STYLE EVAL_PERL PLUGIN_BASE DEBUG DEBUG_ALL CONTEXT ENCODING RELATIVE ABSOLUTE COMPILE_EXT COMPILE_DIR NAMESPACE STRICT));
    $opts->{AUTO_RESET} = 1; # TODO set to 1 for better debugging ASAP
    $opts->{INCLUDE_PATH} = $path;
    # $opts->{PRE_PROCESS} = sprintf '%s_tmpl.txt', $tmplang; # works only at runtime anyway
    $template = new Template $opts or $m->pstop(new_template => O => $opts);
    $m->pstop(bad_template_opts => O => $opts) unless 'Template' eq ref $template;
    $m->pstop(context_no_sarb => undef) unless $template->service->{CONTEXT}->{sarb};
    $m->{template} = $template;
    $m->{ttt2template}->{$tmplang.'_'.$tmpl} = $template;
    $m->dpop1($prog,$template);
};
sub set_template_riidvars { # file:/phm/19/05/12/sig/_lng.phm_pub_sig190512.txt::riidvars set_template and read tml-specific liniverb.txt
    my ($m,$prog,$lihs,$tml,$tmpl) = shift->lpuc('set_template_riidvars',@_);
    my $template = $m->set_template($lihs,$tml,$tmpl);
    $m->{tmplang_linivars}->{$tml} ||= {};
    my $linivars = $m->{tmplang_linivars}->{$tml};
    $m->decho('for %f found linivars %L', f => $tml, L => $linivars);
  RIID: {
      last if %$linivars;
      my $paf = catfile $m->pvar(tmplapptmplangdir => 1), 'liniverb.txt';
      $m->pstop('missing file %f', f => $paf) unless -r $paf;
      $m->riid_tmplvars_fayl($paf, abs => 1, tmplvars => $linivars, setnomval_pur => 1, litstag => 't', typ => 'd');
      $m->pwarn('after reading got linivars %L', L => $linivars);
      $m->{tmplang_linivars}->{$tml} = $linivars;
    };
    # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">插入 litstag 選项, 但其實可更快。唯未知是否需保留 $linivars 與 $lihs->{tvars} 分别身份
    # foreach my $k (keys %$linivars) { my $v = $linivars->{$k};next unless $v;$lihs->putstr($k => $v, litstag => 't', typ => 'd') }; 
    %{$lihs->{tvars}} = %$linivars;
    # </nov>
    # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC"> s(vars)(tvars)
    $m->pwarn('reset undl_verb to %v for tml %f and tmpl %t', f => $tml, t => $tmpl, v => $lihs->{tvars}->{undl_verb}); # </nov>
    $m->dpop1($prog,$template);
};
sub template_include_path {
    my $m = shift;
    return $m->{template}->context->config->{INCLUDE_PATH};
};
sub template_include_file {
    my ($m,$prog,$fb) = shift->ppuc('template_include_file',@_);
    my @dirs = eval { @{$m->template_include_path} };
    $m->pstop(no_include_path => f => $fb) unless @dirs;
    foreach my $dir (@dirs) {
	my $fayl = catfile $dir, $fb;
	next unless -e $fayl;
	return $m->dpop1($prog,$fayl);
    };
    $m->dpop($prog);
};
sub template_context { return shift->{template}->context };
sub template_include { # invoke a file or a block, for file invocation see file:/adv/perl/A2E/MLHT.pm.tmpl::template_include
    my ($m,$prog,$fi,$vars,$fo,%opts) = shift->ppuc('template_include',@_);
    my $template = $opts{template};
    $m->pstop('invalid template supplied in optional argument') if $template and not 'Template' eq ref $template;
    $template = $m->{template};
    $m->pstop('no template in object') if !$template;
    $m->pstop('invalid template in object') if 'Template' ne ref $template;
    my $c = $template->context;
    $m->pstop('invalid template in object') if 'A2E::Template::Context' ne ref $c;
  PREPROC: {
      last if -r $fi;
      last if $c->{BLOCKS}->{$fi};
      my $tmplang = $m->pvar(tmplang => 1);
      my $tmpltxt = catfile '', 'adv', 'tmpl', 'a2e', $tmplang, sprintf '%s_tmpl.txt', $tmplang;
      $c->process($tmpltxt,$vars);
    }; 
    local $_ = eval { $c->include($fi,$vars) };
    $m->pstop('template block %f crashed with message: %m', f => $fi, m => Dumper($@)) if $@;
    my ($so) = m(\A\s*(.*\S)\s*\Z)s;
    return $m->dpop1($prog,$so) unless $fo;
    $m->fayl_put_str($fo,$so);
    $m->dpop1($prog,$fo);
};

=head Function tmplfil_special

Make externally hooked-in directives like

    special process bautext_tmpl.txt

possible

=cut

our %TMPLVARS_FAYL_RANKS = ( important => 2, normal => 1, unimportant => 0 ) ;

sub tmplfil_special_put {
    my ($m,$prog,$lihs,$verb,$fun,%opts) = shift->opuc('tmplfil_special',[qw(nom fun)],@_);
    $m->{tmplfil_special}->{$verb} = $fun;
    $m->dpop1($prog,$fun);
};
sub tmplfil_special_get {
    my ($m,$prog,$lihs,$fun,%opts) = shift->opuc('tmplfil_special_get',[qw(verb2fun)],@_);
    $m->dpop1($prog,$fun);
};

=head3 Functions shared with A2E::MLHT::litscat

=head3 Function num2alpha

take an integer counter value, return a counter value that uses alphabet characters a-z, aa-az, ba-bz, .. za-zz, aaa-aaz, aba-abz, ... eicosahexesimal ($ALPHA_BASIS-based) system with 'z' as zero.

    0 => z
    1 => a
    25 => y
    26 => az
    27 => aa
    52 => bz
    53 => ba

=cut

our $ALPHA_BASIS = 26;
our $ALPHA_OFSET = 96;
sub num2alpha {
    my $m = shift;
    $m->dpuc('num2alpha', @_);
    my $num = shift;
    my @mods = ();
    my $mod = 0;
    while ($num) {
	$mod = $num % $ALPHA_BASIS; # 53 % 26 = 1
	unshift @mods, $mod;
	$m->dgot(num => $num, mod => $mod, mods => \@mods);
    } continue { 
	$num /= $ALPHA_BASIS;  # 53 / 26 => 2.03846153846154
	$num = int $num; # => 2
    };
    unshift @mods, 0 unless @mods;
    my $str = join '', map { $mod = $_ || $ALPHA_BASIS;chr($ALPHA_OFSET + $mod) } @mods;
    $m->dpop1('num2alpha', $str);
    return $str;
};
sub num2Alpha {
    my $m = shift;
    $m->dpuc('num2Alpha', @_);
    local $ALPHA_OFSET = 64;
    my $str = $m->num2alpha(@_);
    $m->dpop1('num2Alpha', $str);
    return $str;
}
sub numpad {
    my $m = shift;
    $m->dpuc('numpad', @_);
    my $str = shift;
    my $strlen = length $str;
    my $len = shift || $strlen;
    my $pad = shift || '0'; 
    $strlen++;
    $str = $pad . $str for $strlen .. $len;
    $m->dpop1('numpad', $str);
    return $str;
}

=head3 Function alpha2num
    
take an alphabetic representation of an integer and return the represented integer.
reverse of num2alpha

    z -> 0
    a -> 1
    e -> 5
    j -> 10
    y -> 25
    az -> 26
    aa -> 27
    ay -> 51
    bz -> 52
    dz -> 104

=cut

sub alpha2num {
    my $m = shift;
    $m->dpuc('alpha2num', @_);
    my $alpha = shift; # 'ba'
    my @alphas = unpack 'C*', $alpha; # ('98', '97');
    my $num = 0;
    my $faktor = 1;
    while (my $keta = pop @alphas) {
	next unless $keta > $ALPHA_OFSET;
	my $ofs = $keta - $ALPHA_OFSET;
	next unless $ofs < $ALPHA_BASIS;
	my $plus = $ofs * $faktor;
	$m->dgot(ofs => $ofs, keta => $keta, alphas => \@alphas, plus => $plus, num => $num, faktor => $faktor); 
	$num += $plus;
    } continue { $faktor *= $ALPHA_BASIS };
    $m->dpop1('alpha2num', $num);
    return $num;
};
sub Alpha2num {
    my $m = shift;
    $m->dpuc('Alpha2num', @_);
    my $ALPHA_OFSET = 64;
    my $str = $m->alpha2num(@_);
    $m->dpop1('Alpha2num', $str);
    return $str;
}
sub romnum {
    my ($m,$prog,$num) = shift->ppuc('romnum',@_);
    my $rom = roman $num;
    $m->dpop1($prog,$rom);
}

=head3 Function sup8fol2nom

Generate lit of next level 
Examples:
    sup8fol2nom($lihs,'top', 'abc') => 'abc'    
    sup8fol2nom($lihs,'top', 'Abc') => 'Abc'    
    sup8fol2nom($lihs,'top', '123') => '123'
    sup8fol2nom($lihs,'top', '_abc') => 'top_abc'    
    sup8fol2nom($lihs,'top', '~123') => 'top123' 
    sup8fol2nom($lihs,'top', '~abc') => 'topabc'
    sup8fol2nom($lihs,'top', 'dd01', 2) => '01'  
    sup8fol2nom($lihs,'oas1908', '_top') => 'oas1908top'    
    sup8fol2nom($lihs,'mm', '~mm01', 2) => 'mm01'  
    args := sup, fol
    rets := nom
    sup => 'top1'
    fol => '~a'
    nom => 'top1a'

=cut

sub sup8fol2nom {
    my ($m,$prog,$lihs,$sup,$fol) = shift->lpuc('sup8fol2nom',@_);
  FOLRX: { # file:/phm/19/01/W00/sig/_lng.phm_pub_sig19W00.txt::folrx
      my $val = $lihs->getstr($sup.'_folrx');
      last unless $val;
      ($fol) = $fol =~ m($val);
    };
    my $nom = $fol;
  PFX: {
      my $pfx = substr $fol, 0, 1;
      my $ifx = '';
    IFX: {
	last if $pfx eq '~';
	last PFX unless $pfx eq '_';
	$ifx = '_' unless $sup =~ m(\d\Z);
      };
      $fol = substr $fol, 1;
      $nom = $sup . $ifx . $fol;
    };
    $m->dpop1($prog,$nom);
};    

=head3 Function grupvar

=cut

sub grupvar { my ($m,$stem,$fol) = @_;$stem.'__'.$fol };

=head3 Function grupfill

Parse-render according to maketext syntax, expanding text variables and markup functions using group-local and global definitions.
Local variables $m->{grupvars} are to be made available at certain junctures by $m->set_grupvars.

=cut

sub grupfill {
    my ($m,$prog,$lihs,$str,%opts) = shift->opuc('grupfill',1,@_);my $grup = $opts{grup};
    my %grupvars = %{$m->set_grupvars($grup)} if $grup;
  GRUPVARS: {
      %grupvars = $m->ref2hash($opts{gvars});
      last if %grupvars;
      %grupvars = $m->ref2hash($m->{grupvars});
      last if %grupvars;
      $grup = $m->{lits}->{__nom};
      last unless $grup;
      %grupvars = %{$m->set_grupvars($grup)} if $grup;
    };
    $m->{sarb}->vars_transform(\%grupvars,$str);
};
sub fayl_fil_lst { # read strings from a file, interpolate them with grupfill, return as list; useful for _deps: file:/adv/perl/A2E/MLDK.pm.tmpl::fayl_fil_lst, file:/sig/oas/19/04/metzW4/tra/vend/Daikufile::fayl_fil_lst
    # optional 2nd argument limits strings by regex, defaults to qr(\A\w)
    my ($m,$prog,$fayl,$rx) = shift->ppuc('fayl_fil_lst',@_);$rx ||= qr(\A\S+\Z);
    return $m->dpop($prog) unless -r $fayl;
    my @vals = ();
    push @vals, map { $m->grupfill($_) } grep { m($rx) } $m->fayl_get_lst($fayl,1);
    $m->dpop($prog,@vals);
};

=head3 Function $m->set_grupvars($grup)

Make local variables (e.g. ep_url = ...) globally available to maketext functions by storing them in $m->{grupvars} and by side-effect in $m->{nom2gvars}->{$grup}
This is useful during reading.
During output, strict local availability through grup_add_grupvars is enough.

OLD TODO:
This mechanism operates both at the tmplfil/parsing level in grupfill and at the rendering level in litscat_simpl, litscat etc where grupfill is also invoked.
It is made necessary by the limitations of the maketext interface, which requires a static vocabulary hash.
Scoping may have been broken, see grupvars in /phm/15/04/05/sig/_lng.phm_pub_sig150405.txt, but suspicion was in this case correctly on the Template module, cf adv1801.litren.
INDEED significantly improved by substituting C<process> in template_include with C<include> file:/phm/19/05/08/sig/_lng.phm_pub_sig190508.txt::tmpl.
One way to clean the system would be to let $m->{sarb}->transform accept a function or an ancestry tree of vocabularies as $grupvars argument.

=cut

sub set_grupvars ($$) { # 1
    my ($m,$prog,$lihs,$grup,%opts) = shift->opuc('set_grupvars',1,@_);
    $m->pstop(funnovar => v => 'nom') unless $grup;
    $opts{gvars} = {};
    my $gvars = $m->grup_add_grupvars($grup,%opts);
    %{$m->{grupvars}} = %$gvars; # GRUPVARS_REFKONST file:/phm/20/10/18/sig/_lng.phm_pub_sig201018.txt::grupvars
    $m->dpop1($prog,$m->{grupvars});
};

=head3 Functions that implement implicit assignments of groups of lines between brackets

Functionality envisaged in dok:adv_pub_litscat1004 and first implemented for version 0.4.0 aka progver 400. 

=head4 nom2lits: return group properties pertaining to a group name

When we are in maketext file parsing mode it is enough to look up these properties in $m->{nom2lits}.
But when we are in vocabulary table reading mode, we may have to reconstruct $m->{nom2lits} from available variables such as, for group 'top', would be

    top__fols
    top__vars
    top__lsts
    top__hacs

=cut

sub nom2lits { # '$lits'
    my ($m,$prog,$lihs,$nom) = shift->lpuc('nom2lits',@_);
    return $m->dpop($prog) unless $nom;
    my $lits = $m->{nom2lits}->{$nom};
    my $var = $m->grupvar($nom,'nom');
    my $val = $lihs->getstr($var);
    return $m->Wpop0($prog, u => 'document %d contains no %n section', g => $nom, d => $lihs->{vars}->{dok}) if !$val;
    $m->pstop(d => 'value of %g is %v, should be %n', g => $var, v => $val, n => $nom) if $val ne $nom;
    $lits->{__nom} = $nom;
    $var = $nom.'__sup';$lits->{__sup} = $lihs->getstr($var);
    foreach my $typ (qw(vars lsts hacs)) {
	$var = $nom.'__'.$typ;
	$val = $lihs->getstr($var);
	next unless $val;
	my @lst = $m->text2list($val);
	my %hac = ();
	$hac{$_} = 1 for @lst;
	$lits->{'__'.$typ} = \%hac;
    };
    $m->{nom2lits}->{$nom} = $lits;
    $m->dpop1($prog, $lits);
};

=head4 $gvars = $m->grup_add_grupvars($nom, grup => $grup, lihs => $lihs, non_rekurs => $non_rekurs, gvars => $gvars)

Find attributes of current grup (text node) and return them.
$nom and $grup start out as same but diverge during recursion.  $nom then becomes a parent group to which we have recurred while $grup is the original for which we are seeking the attributes.
$gvars is the hashref that we are gradually building up.  If not specified, it starts out empty.
The process has been sped up by caching the upper levels in $m->nom2gvars->{$lang} so that in each instance only one level of recursion is needed.
Recursion can be turned off altogether by setting option non_rekurs => 1.
We can search in an external document's tree by setting $lihs as done e.g. in file:/adv/perl/A2E/MLMK.pm.tmpl::lihs_import_grupvars

=cut
our %GRPTYP = (vars => '$', lsts => '@', hacs => '%');
sub grup_add_grupvars {
    my ($m,$prog,$lihs,$gvars,$nom,%opts) = shift->ogpuc('grup_add_grupvars',1,@_);
    my $grup = $opts{grup} || $nom;
    my $top = $grup eq $nom;
    my $non_rekurs = $opts{non_rekurs};
    my $lang = $opts{lang} || $m->pvar(lang => 1);
    return $m->dpop($prog) unless $nom;
    my $lits = $m->nom2lits($lihs,$nom); # is reconstructed from vars when not available
    return $m->Wpop0($prog, d => 'no lits available for node %n', n => $nom) if !$lits;
    my $sup = $lits->{__sup};
  NOMGVARS: { # if pre-stored group variables are available, no need to recurse further up from here
      my %nomgvars = $m->ref2hash($m->{nom2gvars}->{$nom});
      last unless %nomgvars;
      foreach my $k (keys %nomgvars) {
	  next if defined $gvars->{$k}; # write only what was not written at lower level
	  $gvars->{$k} = $nomgvars{$k};
      };
      return $m->dpop1($prog,$gvars);
    };
    my $setgvars = sub {
	my ($tyn) = @_; # 'lsts'
	my $typ = $GRPTYP{$tyn}; # '@'
	my %folp = $m->ref2hash($lits->{'__'.$tyn});
	my $folssn = $m->grupvar($nom,$tyn); # 'sig__lsts'
	my $folss = $lihs->getstr($folssn); # '+slngs+sems+langs+'
	my @fols = !%folp ? $m->text2list($folss) : keys %folp; # qw(slngs sems langs)
	foreach my $fol (@fols) {
	    next if defined $gvars->{$fol}; # ignore if already defined at lower level from where we are recurring upward
	    next if !$top and $lihs->{hacs}->{grupvars_nonheredp}->{$fol}; # file:/phm/19/07/22/sig/_lng.phm_pub_sig190722.txt::nonheredp
	    my $nomfol = $lits->{__nom} . '_' . $fol; # 'sig_slngs'
	    my $val = $opts{lang} ? $lihs->fgetval($nomfol) : $lihs->getval($nomfol); # nomfol2val: '+de+zh+'
	    do { $m->decho(nogvar => g => $tyn, n => $nomfol, l => $lits->{__nom});next } unless defined $val;
	    $val = $m->strval_defarb($lihs,$typ,$nomfol,$val,%opts) if '$' ne $typ and not ref $val;
	    $gvars->{$fol} = $val;
	    next if $nom eq $grup;
	    $gvars->{$fol.'__grup'} = $nom; # 未試、建於 file:/phm/20/09/28/sig/_lng.phm_pub_sig200928.txt::var2lit, 用於 file:/adv/perl/A2E/MLHT.pm.tmpl::_vargrup
	};
    };
    foreach my $tyn (qw(vars lsts hacs)) { 
	&$setgvars($tyn) };
    $m->grup_add_grupvars($sup, grup => $grup, non_rekurs => $non_rekurs, gvars => $gvars, lihs => $lihs) unless $non_rekurs;
    $m->{nom2gvars}->{$nom} = $gvars;
    $m->dpop1($prog,$gvars);
};

=head4 Function grupvars_getstr,grupvars_getlst,grupvars_gethac,grupvars_getval

Take variable value from local group or next possible parent or global variables.

	$val = $m->grupvars_getstr($lihs, $nom => $grp)

=cut

sub lihs_gettypr { # read a string from memo or disk and coerce into type
    my ($m,$prog,$lihs,$nom,$typ) = shift->lpuc('lihs_gettypr',@_);
    my $val = $lihs->getval($nom);
    return unless $val;
    $val = $m->str2arb($val) if $typ and not ref $val;
    my $ref = ref $val;my $tref = $lihs->tref($typ);
    $m->ustop('value %v is of type %r but should be %s', v => $val, r => $ref, t => $tref) unless $ref eq $tref;
    $m->dpop1($prog,$val);
};
sub grupvars_supget {
    my ($m,$prog,$lihs,$nom,$grp,$typ) = shift->lpuc('grupvars_supget',@_);
    return $m->dpop($prog) unless $grp;
    $lihs = $m->get_lihs($lihs);
    my $lits = $m->nom2lits($lihs,$grp);
    return $m->dpop($prog) unless $lits;
    my $vnom = join '_', $grp, $nom;
    my $val = $lihs->gettypr($vnom,$typ);
    return $m->dpop1($prog,$val) if defined $val;
    $val = $m->lihs_gettypr($lihs,$vnom,$typ);
    return $m->dpop1($prog,$val) if defined $val;
    $val = $m->grupvars_supget($lihs,$nom,$lits->{__sup},$typ);
    $m->dpop1($prog,$val);
};
sub grupvars_getvalr {
    my ($m,$prog,$lihs,$nom,$grp,$typ) = shift->lpuc('grupvars_getvalr',@_);
    $grp ||= $m->{lits}->{__nom};
    $m->decho(nogrupvar => n => $nom) unless $grp;
    my $val = $m->grupvars_supget($lihs,$nom,$grp,$typ);
    return $m->dpop1($prog,$val) if defined $val;
    $val = $lihs->getvalr($nom,$typ);
    $m->dpop1($prog,$val);
};
sub grupvars_getval {
    my ($m,$prog,$lihs,$nom,$grp,$typ) = shift->lpuc('grupvars_getval',@_);
    my $val = $m->grupvars_getvalr($lihs,$nom,$grp,$typ);
    return unless $val;
    $lihs = $m->get_lihs($lihs);
    my $typref = $lihs->tref($typ);
    my $valref = ref $val;
    $m->ustop(badref => r => $valref, t => $typref, n => $nom) unless $valref eq $typref;
    $m->dpop1($prog,$val);
};
sub grupvars_getstr {
    my ($m,$prog,$lihs,$nom,$grp) = shift->lpuc('grupvars_getstr',@_);
    my $val = $m->grupvars_getvalr($lihs,$nom,$grp);
    $m->dpop1($prog,$val);
};
sub grupvars_getlst {
    my ($m,$prog,$lihs,$nom,$grp) = shift->lpuc('grupvars_getlst',@_);
    my $ref = $m->grupvars_getval($lihs,$nom,$grp,'@');
    return $m->dpop($prog) unless $ref;
    $m->dpop($prog,@$ref);
};
sub grupvars_gethac { 
    my ($m,$prog,$lihs,$nom,$grp) = shift->lpuc('grupvars_gethac',@_);
    my $ref = $m->grupvars_getval($lihs,$nom,$grp,'%');
    return $m->dpop($prog) unless $ref;
    $m->dpop($prog,%$ref);
};

=head4 Function supnum2fol

    args := sup, num
    rets := fol
    sup => top1
    num => 2
    fol => b
    sup :: name stem of current node i.e. name of upper node
    num :: ordinal number

=cut

sub supnum2fol {
    my $prog = 'supnum2fol';my $m = shift;$m->dpuc($prog, @_);
    my ($sup,$num) = @_;
    $m->pstop(nonnumsfx => n => $num) unless $num =~ m(\A\d+\Z);
    my $fol = $sup =~ m(\D\Z) ? $num : $m->num2alpha($num);
    $m->dpop1($prog, $fol);
}

=head4 Function grupopen_supfol2nomfol

Generate the full name and leaf name that need to be stored in the vocabulary database, e.g. in variables like top__fols, so as to enable reconstruction of the group during output formatting. 

    $m->grupopen_supfol2nomfol($lihs,'top', 'intro') => 'intro', 'intro'
    $m->grupopen_supfol2nomfol($lihs,'top', '') => 'top1', '~1'

    args := nom0, fol0
    rets := nom, fol
    nom :: resulting full name of node
    fol :: resulting leaf name of node
    nom0 :: initial name of node, i.e. name of upper node
    fol0 :: initial name of leaf, i.e. what was found when opening the group
    nom0 => 'top', fol0 => 'intro', nom => 'intro', fol => 'intro'
    nom0 => 'top', fol0 => '_intro', nom => 'top_intro', fol => '_intro'
    nom0 => 'top', fol0 => '', nom => 'top1', fol => '~1'

TODO: remove redundancies/conflicts with sup8fol2nom

=cut

sub grupopen_supfol2nomfol { # $nom, $fol
    my ($m,$prog,$lihs,$nom,$fol) = shift->lpuc('grupopen_supfol2nomfol',@_);
  NOM: {
      FOL: {
	  last if !$fol;
	  $nom = $m->sup8fol2nom($lihs,$nom,$fol);
	  last NOM;
      };
	$m->ustop(topanon => undef) unless $nom;
      NUM: {
	  my $num = ++$m->{lits}->{__num};
	  $fol = $m->supnum2fol($nom, $num);
	};
	$nom .= $fol;
	$fol = '~' . $fol;
    };
    $m->dpop($prog,$nom,$fol);
};

=head5 Function grupopen_jungils file:/adv/perl/A2E/OLD/Tmplfil.old::grupopen_jungils

=head4 Function grupopen

    args := ignor, lini
    rets := ok, nom
    lini :: line to be parsed, starts with C<($fol0> and may end with C<)>, in which case the C<mini> form that invokes values from elsewhere is found.
    ignor :: whether to ignore this section
    ok :: successfully parsed as a group opener
    nom :: name of the group that we entered into

Open a litsgrup, set up current level's $m->{lits} with builtin variables.
  __sup:	name of superior node hashref, data must be available via $m->{nom2lits} under this index
  __lvl:	current hiearchy level, starting from 1
  __num:	sequential order number at the current level
  __nom:	absolute name of this node
  __fol:	leaf name such that from this in combination with the absolute name of the upper node the absolute name of this node can be derived: either a suffix to be attached literally or an absolute name prefiged by ^
  __fols:	ordered list of leaf names (cf __fol) of members of this node

Line to be parsed can take a variety of forms, e.g.

    (top /proc+alineas/proc+sekt+jungil+alineas/proc+alineas/ # ending ) comes in later line
    (mlhtdefs)
    (papridir /proc+tititemlist/ ! +papri+europarl0309+konf0506+europarl0507+)


Internal variables
    $nom ::  textchunk name
    $m->{nom2lits} :: table of hashrefs representing nodes
    $m->{lits} :: current node (?)
    $lits :: to-be-opened node (?)

=head5 grupopen_elgrup, kopivars, ...

Moved to file:/adv/perl/A2E/OLD/Tmplfil.old::grupopen_elgrup

Functionality is now taken over by kopifols, syntax still quite similar.

The following should work:

	(tab1 @tabxs
        ...
        )
	(tab2 ! tab1)

A longer way to write tab2 would be

	(tab2
	@kopilits = |+tab1+fols+|
        )  

It should still be possible to write

	(tab2 @tabxs2 ! tab1)
	(tab2 @tabxs2 ? tab1)

etc.  The latter would mean that any previous definition of tab2, e.g. one coming from a variant/language file, would take precedence.
This syntax is untested but the @kopilits form does work.

=head5 kopilits

=cut

our %nonkopivarp = ( _nom => 1, _lvl => 1, _sup => 1, _num => 1, _fol => 1) ; #
sub kopivars_setarbs { # merge tree variables set locally with imported ones
    my ($m,$prog,$lihs,$optsr,$gvars,$typ,$merge,$lit0,$lit1,$lihs0) = shift->tgpuc('kopivars_setarbs',@_);my %opts = $m->ref2hash($optsr);
    my $treg = $lihs->treg($typ); # hacs
    my $lit0typ = join '__', $lit0, $treg; # srctab__hacs
    my @atr0l = $m->val2lst($lihs->getstr($lit0typ,$lihs0)); # ('voks', 'sizs')
    return $m->dpop($prog) unless @atr0l;
    my $lit1typ = join '__', $lit1, $treg; # 'dsttab__hacs'
    my @atr1l = $m->textsep2list($lihs->getstr($lit1typ)); # ('alns')
    my %atr1p = ();$atr1p{$_} = 1 for @atr1l; # (alns => 1)
    $m->{nom2lits}->{$lit1}->{'__'.$treg}->{$_} = 1 for @atr1l;
    while (my ($k,$v) = each %{$m->{nom2lits}->{$lit1}->{'__'.$treg}}) { push @atr1l, $k if $v and !$atr1p{$k} }; # fix potential inconsistencies
    foreach my $atr0 (@atr0l) {
	next if $nonkopivarp{$atr0};
	my $nom0 = $lit0.'_'.$atr0;
	my $val0 = $lihs->getstr($nom0,$lihs0);
	my $nom1 = $lit1.'_'.$atr0;
	next unless defined $val0;
	my $val1 = $lihs->getstr($nom1);
	# <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
	# my $arb1 = $lihs->{vars}->{$nom1};
	my $arb1 = $lihs->vgetval($nom1);
	# </nov>
	do { $arb1 = $m->str2arb($val1) } unless ref $arb1;
	my $arb0 = $val0;if (ref $arb0) { $val0 = $m->arb2str($arb0) } else { $arb0 = $m->str2arb($val0) };
	$arb0 = &$merge($arb0,$arb1);
	$val0 = $m->arb2str($arb0);
	$lihs->putstr($nom1 => $val0, %opts);
	$gvars->{$atr0} = $arb0;
	# $lihs->{vars}->{$nom1} = $arb0 unless $dyna;
	do { push @atr1l, $atr0;$atr1p{$atr0} = 1 } unless $atr1p{$atr0};
	$lihs->{$treg}->{$nom1} = $arb0;
	$m->{nom2lits}->{$lit1}->{'__'.$treg}->{$atr0} = 1;
    };
    my $atr1s = join '+', '', @atr1l, '';
    $lihs->putstr($lit1typ => $atr1s, %opts); # '+voks+sizs+alns+', listvar not needed for internal purpose
    $m->dpop($prog,@atr1l); # allow push
};

sub kopivars { # copy attributes of group, cf examples in file:/sig/oas/19/05/demcW5/tra/avoc.txt::/\bkopilits\b/
    my ($m,$prog,$lihs,$optsr,$lit0,$lit1) = shift->tpuc('kopivars',@_);my %opts = $m->ref2hash($optsr);
    my $prt = $opts{prt} || '';
    my $dyna = $opts{dyna} ? 1 : 0;
    my ($dok0,$lihs0,$lit0r) = (); 
    if ('ARRAY' eq ref $lit0) { # dok_kopivars: read from external document; works but need to adapt dok2tmplvars to new file-storage .lits/zh/* paradigm
	($dok0,$lit0,$lihs0) = @$lit0;
	$lihs0 ||= $m->dok2tmplvars(d => $dok0);
	$lit0r = [$dok0,$lit0,$lihs0];
    };
    $lihs0 ||= $lihs;
    my %grupvars = ();
    my $vars0nom = $lit0.'__vars';
    my @vars0 = $m->val2lst($lihs->getstr($vars0nom,$lihs0));
    my $vars1nom = $lit1.'__vars';
    my @vars1 = $m->val2lst($lihs->getstr($vars1nom));
    $m->{nom2lits}->{$lit1}->{__vars}->{$_} = 1 for @vars1;
    foreach my $var (@vars0) { # file:/phm/20/11/19/sig/_lng.phm_pub_sig201119.txt::foreach_var_fols_vars 
	next if $nonkopivarp{$var};
	my $nom0 = $lit0.'_'.$var;
	my $val0 = $lihs->getstr($nom0,$lihs0);
	do { $m->pwarn('found ref value for string var %n', n => $nom0);$val0 = $m->arb2str($val0) } if ref $val0;
	next unless length $val0; # dont copy '' but do copy '0' values
	my $nom1 = $lit1.'_'.$var;
	my $val1 = $lihs->getstr($nom1,$lihs);
	$val1 = length $val1 ? $val1 : $val0;
	$lihs->putstr($nom1 => $val1, %opts);
	# <nov id=kopivars_dynaput orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">似冗餘, 且已不能容忍直接指定
	# $lihs->{vars}->{$nom1} = $val1 unless $dyna;
	# </nov>
	do { push @vars1, $var;$m->{nom2lits}->{$lit1}->{__vars}->{$var} = 1 } unless $m->{nom2lits}->{$lit1}->{__vars}->{$var};
	$grupvars{$var} = $val1;
    };
  VARS1VAL: {
      @vars1 = grep {$_} @vars1;
      last unless @vars1;
      my $vars1val = join '+', '', @vars1, '';
      $lihs->putstr($vars1nom => $vars1val, %opts);
      # $lihs->{vars}->{$vars1nom} = $vars1val unless $dyna;
    };
    my %typ2mrg = (
	'@' => sub { my ($l1,$l2) = @_;my @l = $m->uniqpush($l2,$l1);\@l }, 
	'%' => sub { my ($h1,$h2) = @_;my $h = $m->hashpush('ad',$h1,$h2);$h } );
    $m->kopivars_setarbs({ %opts, gvars => \%grupvars },$_,$typ2mrg{$_},$lit0,$lit1,$lihs0) for '@','%';
    $m->dpop($prog,%grupvars);
};

sub kopifols { # copy complete info tree, e.g. table, cf examples in file:/sig/oas/19/05/demcW5/tra/avoc.txt::/\bkopilits\b/
    my ($m,$prog,$lihs,$optsr,$lit0,$lit1) = shift->tpuc('kopifols',@_);my %opts = $m->ref2hash($optsr);
    my $prt = $opts{prt} || '';
    my $dyna = $opts{dyna} ? 1 : 0; # in reading stage where possibilities are more open we only store string variables
    my $verbose = $m->pvar(verbose => 1);
    $opts{echo} ||= $verbose;
    $m->decho('kopifols [prt %p] de %a al %b', p => $prt, a => $lit0, b => $lit1);
    my ($dok0,$lihs0,$lit0r) = ();
    if ('ARRAY' eq ref $lit0) { # importing from external document via $lit0 record argument $lit0r derived from expr as in file:/sig/oas/19/07/jnwpW7/tra/publ.txt::jnwpW7_papl
	($dok0,$lit0,$lihs0) = @$lit0;
	$lihs0 ||= $m->dok2tmplvars(d => $dok0);
	$lit0r = [$dok0,$lit0,$lihs0];
    };
    $lihs0 ||= $lihs;
    $lit0r ||= $lit0;
    my $lit1nom = $lihs->getstr($lit1.'__nom');
    $m->pwarn('%n has bad nom %v even before kopivars', n => $lit1, v => $lit1nom) unless !$lit1nom or $lit1nom eq $lit1;
    my %grupvars = $m->kopivars($optsr,$lit0r,$lit1);
    # file:/phm/20/11/19/sig/_lng.phm_pub_sig201119.txt::lit1nom_korr
  FOLS: {
      last unless 'fols' eq $prt;
      my %nomval = ();
      local $_;
      foreach my $k (qw(_fols _frm)) { # __fols__frm
	  my $l1k = $lit1.'_'.$k;
	  my $v = $lihs->getstr($l1k);
	  next if $v;
	  my $l0k = $lit0.'_'.$k;
	  $v = $lihs0->getstr($l0k);
	  $nomval{$l1k} = $v;
	  $grupvars{$k} = $v;
      }; 
      my $setnomval = sub {
	  foreach my $k (keys %nomval) {
	      my $v = $nomval{$k};
	      next unless $v;
	      $lihs->defstr($k => $v, %opts);
	  } };
      &$setnomval;
      my @fols = $m->text2list($nomval{$lit1.'__fols'});
      foreach my $fol (@fols) {
	  my $nom0 = $m->sup8fol2nom($lihs,$lit0,$fol);
	  my $nom1 = $m->sup8fol2nom($lihs,$lit1,$fol);
	  # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
	  # next if $lihs->{vars}->{$nom1}; # allow overwriting in grup into which we import
	  next if $lihs->vgetval($nom1); # allow overwriting in grup into which we import
	  # </nov>
	  my $nom0r = $dok0 ? [$dok0,$nom0,$lihs0] : $nom0;
	  $m->kopivars($optsr,$nom0r,$nom1);
	  %nomval = ();
	  $nomval{$nom1.'__sup'} = $lit1;
	  my $val0 = $lihs0->getstr($nom0);
	  if ($val0) { $nomval{$nom1} = $val0 } else { $nomval{$nom1.'__nom'} = $nom1 }; # 或名或値規則 file:/phm/20/11/19/sig/_lng.phm_pub_sig201119.txt::nomnom_xor_nomval
	  &$setnomval;
	  $m->kopifols($optsr,$nom0r,$nom1);
      };
    };
    $m->dpop($prog,%grupvars);
};

sub kopilits { # copy attributes and optionally leaves from a list of text blocks; in initial more dynamic stage $dyna reading attributes is enough; leaves are useful only in A2E::MLHT::litscat context; attributes are needed because they can contain reading directives like '@slngs'
    my ($m,$prog,$lihs,$optsr,$gvars,$litstem) = shift->tgpuc('kopilits',@_);my %opts = $m->ref2hash($optsr);
    my $val = $lihs->getstr($litstem.'_kopilits',$lihs);
    return $m->dpop($prog) unless $val;
    my $dyna = $opts{dyna} ? 1 : 0;
    $opts{lihs} ||= $lihs;
    $opts{nonstorp} = !$dyna;
    $opts{dyna} = $dyna;
    $opts{litstag} = $opts{flng} && $opts{litstag}; # neutra se non legita da *.${flng}.txt
    my @lits  = $m->val2lst($val);
    foreach my $lit (@lits) {
	($lit,my $prt) = $m->val2lst($lit);
	$opts{prt} = $dyna ? 'vars' : $prt || 'vars';
      LITREF: { # e.g. file:/sig/oas/19/07/jnwpW7/tra/publ.txt::jnwpW7_papl
	# file:/phm/19/07/21/sig/_lng.phm_pub_sig190721.txt::dokkopilits
	  last if ref $lit;
	  local $_ = $lit;
	  my ($sep) = m((\W));
	  last unless $sep;
	  $lit = $m->textsep2listref($lit,$sep)
	};
	my %grupvars1 = $m->kopifols(\%opts,$lit,$litstem); # kopifols_novopts
	$gvars->{$_} ||= $grupvars1{$_} for keys %grupvars1;
    };
    $m->dpop1($prog,$gvars);
};


=head5 main function grupopen

C<$1> $_ is a line that is found to match '\A\('.
C<$2> $rank_ignor if on means that processing is not needed because we are currently reading only configuration values and not text

TODO: enable verbatim processing for documentation purposes as suggested in adv1801

  (_vbrv<
  # hier dann nicht mehr nötig: special = verbatim EOT
  ( @lc
  活性領域を含む活性領域基板層を有する基板中に構成された半導体装置であって、
  (_ol=
  # hier dann nicht mehr nötig: special = litverb
  labfmt = （$(alpha|${_num})）
  前記活性領域基板層上に誘電体層を配置するステップと、
  (
  第１のマスクを使用して、
  前記活性領域上の前記誘電体層中にコンタクトホールを形成し、
  前記コンタクトホールの周囲の前記誘電体層中に静電気放電保護開口を形成するステップと、
  )
  (
  第２のマスクを使用して、前記コンタクトホールおよび静電気放電保護開口中にオーミックコンタクトメタライゼーションをデポジットして、
  前記活性領域上の前記誘電体層中に配置され前記活性領域と電気的に接触する金属活性領域コンタクトと、
  前記活性領域コンタクトの周囲の前記誘電体層中に配置された金属静電気放電保護構造とをそれぞれ形成するステップと、
  )
  )
  ${_ol}に従って形成され、
  前記静電気放電保護構造は、前記誘電体層の表面上の電荷に対する直接的静電気放電路を形成するよう前記活性領域基板層と電気的に接触するものである、
  半導体装置。
  )_vbrv>


=cut

sub grupopen_cift_frm {
    my ($m,$prog,$lihs,$sup,$lits) = shift->lpuc('grupopen_cift_frm',@_);$lits ||= $m->{lits};
    return $m->dpop($prog) unless $sup;
    return $m->dpop($prog) unless $lits;
    my $frmt = $lits->{__frm};
  FRMT: {
      last if $frmt;
      my $frmn = $m->grupvar($sup,'frm');
      $frmt = $lihs->getstr($frmn);
    };
    return $m->dpop($prog) unless $frmt;
    my $frmlr = $m->str2arb($frmt);
    return $m->dpop($prog) unless 'ARRAY' eq ref $frmlr;
    my @frml = @$frmlr;
    return $m->dpop($prog) unless @frml;
    shift @frml;
    return $m->dpop($prog) unless @frml;
    $frmt = $m->arb2str(\@frml,['/','+']);
    $m->dpop1($prog,$frmt);
};
sub grupopen_pars_frm ($$;) { # read '@vrb' or '/proc+verbatim/proc+linioi/' into a $listref
    my ($m,$prog,$lihs,$s) = shift->lpuc('grupopen_pars_frm',@_);
    return $m->dpop($prog) unless $s;
    return $m->dpop1($prog,$lihs->getstr($1)) if $s =~ m(\A\@(.*)\Z);
    $s = $m->grupfill($s); # allow variables e.g. /+proc+ltximg+imgnom+tikz_luwh_${var}+/ file:/sig/oas/20/07/ecodX7/tra/wart/_lng.ecodX7_wart.txt::tikz_luwh_
    $m->dpop1($prog,$s);
};
sub grupopen_stor_frm ($$$;) {
    my ($m,$prog,$lihs,$nom,$frmt,$lits) = shift->lpuc('grupopen_stor_frm',@_);
    return $m->dpop($prog) unless $nom;
    return $m->dpop($prog) unless $frmt;
    $lits ||= $m->{lits} || $m->pstop(funnovar => v => 'lits');
    $lits->{__frm} = $frmt;
    $lits->{__vars}->{_frm} = 1;
    my $gvar = $m->grupvar($nom,'frm');
    $lihs->putstr($gvar,$frmt,echo => $m->{debug}, typ => 'd');
    $m->dpop1($prog,$frmt);
};
sub lits_put_atr {
    my ($m,$prog,$nom,$val,$lits) = shift->ppuc('lits_put_atr',@_);$lits ||= $m->{lits} || $m->pstop(nolits => { n => $nom, v => $val }); 
    $lits->{$nom} = $val;
}
sub lits_nov_atr {
    my ($m,$prog,$nom,$val,$lits) = shift->ppuc('lits_put_atr',@_);$lits ||= $m->{lits} || $m->pstop(nolits => { n => $nom, v => $val }); 
    $lits->{$nom} ||= $val;
}
sub grupopen_sup_put_fol { # register new node with the parent
    my ($m,$prog,$sup,$fol,$ignor,$litverb) = shift->ppuc('grupopen_sup_put_fol',@_);
    return $m->dpop($prog) unless $sup;
    do { $m->{lits}->{__vrbs}->{$fol} = 1;$m->dpop1($prog,1) } if $litverb;
    $m->lits_nov_atr(__fin => 2) if $ignor;
    return $m->dpop1($prog,1) if $m->{lits}->{__fin} == 2;
    $m->lits_nov_atr(__fin => 1); # kludge include_fin0 file:/phm/19/06/20/sig/_lng.phm_pub_sig190620.txt::h12r
    $m->pstop(supnofols => s => $sup) unless 'ARRAY' eq ref $m->{lits}->{__fols};
    return $m->Wpop0($prog, p => 'folinnfols', f => $fol, F => $m->{lits}->{__fols}, n => $sup) if $m->{lits}->{__folp}->{$fol};
    push @{$m->{lits}->{__fols}}, $fol;
    $m->{lits}->{__folp}->{$fol} = 1;
    $m->dpop1($prog,1);    
};
sub grupopen_varsput {
    my ($m,$prog,$lihs,$optsr,$nom,$lits,@vars) = shift->tpuc('grupopen_varsput',@_);my %opts = $m->ref2hash($optsr);
    foreach my $var (@vars) { 
	my $val = $lits->{'__'.$var};
	next unless $val;
	my $tvar = $m->grupvar($nom,$var);
	$lihs->putstr($tvar => $val, echo => $m->{debug}, typ => 'd', %opts);
	$lits->{__vars}->{'_'.$var} = 1;
    };
    $m->dpop1($prog,1);
};
sub grupopen_frmt_fols_set_lsts_hacs {
    my ($m,$prog,$lihs,$optsr,$nom,$frmt,$lits,$fols,$ignor,$lits_ignor) = shift->tpuc('grupopen_frmt_fols_set_lsts_hacs',@_);
    my %opts = $m->ref2hash($optsr);
    $lits ||= $m->{lits} || $m->pstop(funnovar => 'v' => 'lits');
    $lits->{__vars} ||= {};
    $lits->{__lsts} ||= {};
    $lits->{__hacs} ||= {};
    $opts{litstag} = '' unless $opts{flng};
    $m->grupopen_varsput($optsr,$nom,$lits,qw(nom fol sup num lvl frm));
    $m->grupopen_stor_frm($lihs,$nom,$frmt,$lits) unless $ignor;
    return $m->dpop($prog) if $lits_ignor;
    $lits->{__fols} ||= [];
    $lits->{__fols} = $fols if $fols;
    $lits->{__num} = 0;
    $m->dpop1($prog,1);
};
sub grupopen_init_lits { # even in ignored groups we need fields like __nom that tell us where we are
    my ($m,$prog,$lits,$nom,$sup,$lvl,$fol,$ignor,$verbatim,$litverb) = shift->ppuc('grupopen_init_lits',@_);
    $m->pstop(nusekt => n => $nom, l => $lits) unless $nom;
    $lits->{__nom} = $nom;
    $lits->{__sup} = $sup;
    $lits->{__lvl} = $lvl;
    $lits->{__fol} = $fol;
    $lits->{__ignor} = $ignor;
    $lits->{__verbatim} = $verbatim if defined $verbatim;
    $lits->{__litverb} = $litverb if defined $litverb;
    $m->dpop1($prog,$lits);
};
our %statsymp = ('!' => 1, '?' => 1);

=head4 ($ok,$nom2) = $m->grupopen(\%opts,$s): identify a group opening line $s that begins with parenthesis opener based on %opts
$s has been found to begin with '(' before we start.
=cut
sub grupopen {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('grupopen',@_);local $_ = $s;my %opts = $m->ref2hash($optsr);
    my $rank_ignor = $opts{rank_ignor};
    my $lits_ignor = $m->{lits}->{__ignor}; # ignore because grup is optional and a grup of same name was already evaluated
    # TODO ignorfin: eliminate duplicate information between __ignor and __fin, clean up and document $m->{lits} data structure; file:/phm/19/06/10/sig/_lng.phm_pub_sig190610.txt::ignorfin
    my $ignor = $rank_ignor || $lits_ignor;
    $opts{rank_ignor} = $ignor;
    my $sep = '';
    my $fol0 = '';
    my $specsekt = ''; # addons to grup e.g. '<<EOT' or '='
    my $rest = ''; # formatters etc
    my $kloz = ''; # closing parenthesis
    $_ = substr $_, 1;
  KLOZ: { # line with closer at end
      last unless $_;
      ($rest, $kloz) = m(\A(.*)([\)])\Z);
      last unless $kloz;
      $_ = $rest;
    };
  IGNOR: { # warn and return when encountering an opening parenthesis that doesnt open a section
      last unless $_;
      ($fol0) = m(\A(\S+)\Z); 
      last if $fol0;
      ($fol0, $rest) = m(\A(\S*)(\s[/@].*)\Z);# $rest contains anything that trails, not just formatter info but also potentially final ? or ! and more
      last if $fol0;
      last if $rest and not $kloz;# allow '( @vrb' but not '( @vrb)'
      $m->uwarn(notgrupopen => l => $_, k => $kloz ? ')' : '');
      return $m->dpop($prog);
    };
    my ($litverb, $verbatim) = (); # undefined
    # $m->grupopen_get_specsekt; # file:/adv/perl/A2E/OLD/Tmplfil.old::grupopen_get_specsekt
    $_ = $rest;
    my $sup = $m->{lits}->{__nom};
    my $sup_verbatim = $m->grupvars_getstr($lihs,__verbatim => $sup);
    return $m->dpop($prog) if $sup_verbatim;
    $m->ustop('sektnomnil') unless $fol0 or $sup;
    my $lvl = $sup ? $m->{lits}->{__lvl} : 0;$lvl++;$m->{__flvl}++;
    my ($nom, $fol) = $m->grupopen_supfol2nomfol($lihs, $sup, $fol0);
    my $val = $lihs->getstr($nom); # grupopen_nomfol
    $m->uwarn(regrup => n => $nom, v => $val) if $val;
  OLDSUP: {
      last unless $m->{nom2lits}->{$nom} and $sup;
      my $oldsup = $m->{nom2lits}->{$nom}->{__sup} || '0O0';
      last if $sup eq $oldsup;
      $m->ustop('trying to insert group %n under %s but it is already under %o', n => $nom, s => $sup, o => $oldsup);
    };
    my $sup1 = $sup;
    while ($sup1) { # check for circularity: $nom must not be present among parents
	$m->ustop(nomcirkl => n => $nom) if $nom eq $sup1;
	$sup1 = $m->{nom2lits}->{$sup1}->{__sup};
    };
    my $fin = 0;
    my $stat = 0;
    my $lits = $m->{nom2lits}->{$nom} || {};
    $lits->{__fsup} = 1 if $lits->{__sup} and not $sup;
    $m->pstop(nomlits =>  n => $nom, l => $lits) unless 'HASH' eq ref $lits;
    my $initlitsfols = sub {
	$m->lits_put_atr(__fin => 0, $lits); # group just starting, not finished
	$lits->{__lini} = 0; # line number as read from multilingual source file, where only every other line is read into the tree with a number $lits->{__num}
	$lits->{__fols} ||= [];$lits->{__folp} = {};
	$lits->{__fols};
    };
    my $fols = &$initlitsfols($lits);
    my $grupopen_args = sub { # parse all arguments of the opener line, up to a possible closing bracket
	my $next = shift;
	return unless $next;
	my $ignor = shift;
	return if $ignor;
	my $kloz = shift;
	my ($sep, @args) = $m->textsep2seplist(substr($next,1),substr($next,0,1));
	# $sep is space or '|', $next may be C</proc+verbatim/proc+ilinioi/> or C<@vrb>, 
	$next = shift @args;
	my $frmt = '';
      unless ($statsymp{$next}) { # 150210 added $ignor
	  $frmt = $next;
	  $next = shift @args;	    
      };
	return $frmt unless $next;
	# following @args used to be ('!', '+papri+europarl0309+...+') but are now unused
	$next = shift @args;
	# last unless $next;
	my $goto_korp = sub {
	    return unless $next =~ m(\A[?!]\Z);
	  FIN: {
	      do { $m->lits_put_atr(__fin => 2);last } if $ignor;
	    NEXT: {
		if ('?' eq $next) { $lits->{__fin} = @{$lits->{__fols}} ? 2 : 1;last };
		if ('!' eq $next) { $lits->{__fin} = 1;@{$lits->{__fols}} = ();%{$m->{$lits->{__folp}}} = ();last };
	      };
	    };
	    return shift @args; 
	};
	$next = &$goto_korp($next,@args);
	return $frmt unless $next;
	$m->ustop(finkloz => n => $next) unless $kloz;
	$m->kopifols($optsr,$next,$nom); # OLD: my $elgrup = sub { $lits->{__fin} ||= 1; ($lits, $fols) = $m->grupopen_elgrup($nom, $next, $lits, $fols); }; &$elgrup unless $ignor or !$kloz or $lits->{__fin} == 2;
	return $frmt;
    };
    my $frmt = &$grupopen_args($_,$ignor,$kloz);
    $frmt = $m->grupopen_pars_frm($lihs,$frmt) if $frmt;
    $frmt ||= $m->grupopen_cift_frm($lihs,$sup);
    my $fol_lits_setup = sub {
	$m->grupopen_init_lits($lits,$nom,$sup,$lvl,$fol,$ignor,$verbatim,$litverb);
	return if $rank_ignor; # in ignored groups we do not care about subgroups and register exported variables only with their absolute names as done in tmplini_setnomval
	$m->grupopen_frmt_fols_set_lsts_hacs($optsr,$nom,$frmt,$lits,$fols,$ignor,$lits_ignor);
    };
    &$fol_lits_setup;
    $m->grupopen_sup_put_fol($sup,$fol,$ignor,$litverb);
    $m->{nom2lits}->{$nom} = $lits;
    $m->{lits} = $lits;
    # $m->grupopen_jungils($nom, $frmlr, $lits) unless $ignor;
    if ($kloz) {
	($nom) = $m->grupkloz_setlits($optsr,$nom);
    } else { # proper opening
	$m->pstop(setnusekt => l => $lits) unless $lits->{__nom};
	$m->set_grupvars($nom,%opts) unless $rank_ignor;
    };
    $m->dpop($prog,1,$nom);
}; #grupopen

=head4 Function grupkloz_setvars

Synopsis

    args := nom
    rets := ok

Set some textchunks that carry information about the current group, particularly its components and local variables of various types, so that the group can be reconstructed later.  The information stored here doesn't comprise the variable values, which are stored by tmplini_setnmomval earlier.

This must be done both when a ')' line is encountered and when a group opener line ends with a closer.
m->{lits} must previously have been set to contain the collected metainfo of
the node that is ending here.

$klozp :: whether we are preparing to close the whole grup (1) or only the attribute section (0); 
TODO: KLOZP: should't this be done on entry into grupkorp ? the klozp part is done on grup closing, the rest on transition to body

=cut

sub grupkloz_setvars {
    my ($m,$prog,$lihs,$optsr,$nom,$klozp) = shift->tpuc('grupkloz_setvars',@_);my %opts = $m->ref2hash($optsr);
    my $verbose = $m->pvar(verbose => 1);
    if ($klozp) { delete $m->{lits}->{'__'.$_} for qw(fin lini) };
    $opts{dyna} = 1;
    $opts{litstag} = $opts{flng} && $opts{litstag};
    $opts{echo} ||= $verbose;
    $opts{typ} = 'd';
    $m->kopilits(\%opts,$nom); # kopilits_novopts
  STAT: {
      last unless $klozp;
      last unless $m->{lits}->{__stat};
      my $var = $m->grupvar($nom, 'stat');      
      $lihs->putstr($var => 1, %opts);
      delete $m->{lits}->{__stat};
    };
    my @vars = $klozp ? qw(fols) : qw(vars lsts hacs);
    foreach my $typ (@vars) {
	my $var = $m->grupvar($nom, $typ); # olgmV9__fols
	my $ref = $m->{lits}->{'__'.$typ}; # __fols => \%fols
	my $typnom = $typ eq 'fols' ? 'ARRAY' : 'HASH';
	next if $typnom ne ref $ref;
	my @lst = $typnom eq 'ARRAY' ? @$ref : keys %$ref;
	next if !@lst; # neputnonfols: 不寫空的 __fols __vars 等
	my $slst = $m->arb2str(\@lst,['+']);
        # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
 	# $lihs->{var2typ}->{$var}->{d} = 1;
	# $lihs->{typ2var}->{d}->{$var} = 1;
        # </nov>
	$lihs->putstr($var => $slst, %opts);
    };
    # file:/adv/perl/A2E/OLD/Tmplfil.old::GRUPKLOZ_SETVRBS
    $m->dpop1($prog,1);
};

=head4 Function grupkloz

Deal with a line consisting of a closing bracket, optionally followed by the name of the group to be closed by it, e.g. the lines after the ... content:

    (vrb<
    (p2pat
    (
    ....
    )
    )p2pat
    )_vrb>

This has been complicated by verbatim mode.

with EBNF synopsis

    args := ignor, lini
    rets := ok, nom
    lini :: the suspicious line, starting with closing bracket, without final LF
    sup := the name of the group that we are in now
    lits :: a hashref of known attributes of our group, also stored in $m->{lits};
    ok :: Was found to be a group closer and not just a verbatim bracket character
    nom :: the group that we are returning to, nil if top level

=cut

sub grupkloz {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('grupkloz',@_);local $_ = $s;my %opts = $m->ref2hash($optsr);
    my $rank_ignor = $opts{rank_ignor}; # ignore because of low rank/priority of file
    my $fol = $m->{lits}->{__fol};
    $_ = substr $_, 1; # ')~m' => '~m'
    my $nom = $m->{lits}->{__nom};
    my $verbatim = $m->grupvars_getstr($lihs,__verbatim => $nom); # we are in a verbatim group where ordinary closers are ignored but stuff like ')_vrb>' is not.
  FOL_ARG: { #Deal with cases where there is trailing matter after the closing bracket. All verbatim group closers must be named.
      last unless $_;
      my ($fol_arg,$verbatim_kloz) = m(\A(\~?\w+)(\>?)\Z);
      return $m->Wpop0($prog,u => 'This looks dangerously similar to a group closing bracket: %l', l => $_) unless $fol_arg;
    VERBATIM: { # Make sure that if a verbatim group closer such as 'vrb>' was found then it matches the verbatim group that was last opened
	do { $m->ustop('Attempting to close inexistent verbatim group %f', f => $fol_arg) if $verbatim_kloz;last } unless $verbatim;
	return $m->dpop($prog,0,$nom) unless $verbatim_kloz; # leave without closing if we are in verbatim mode without a proper verbatim closer; verbatim groups are meant to talk about all sorts of grammatical errors so we quit here.
	last if $fol_arg eq $verbatim; # check validity of closer
	$m->ustop(q{Attempting to close verbatim group '%f' but we are in '%v'}, f => $fol_arg, v => $verbatim);
      };
      last if $fol_arg eq $fol;
      $m->ustop('encountered closer for %c but we are in %f aka %n', c => $fol_arg, f => $fol, n => $nom);
    };
    # now properly close the group, be it normal or verbatim, return $nom of parent group 
    ($nom) = $m->grupkloz_setlits($optsr,$nom);
    $m->{__flvl}--;
    $m->dpop($prog,1,$nom);
};

=head5 Subfunction grupkloz_setlits

Heart piece of grupkloz, close a group without parsing a closer line.

    args := nom, rank_ignor?
    rets := sup, lits
    lits := hashref

nom is the name of the textchunk that we are closing.
We now leave this section, storing needed info, and set our current textchunk info m->{lits} to its parent.
This is a subfunction of grupkloz that is also needed by grupopen in cases where a section closes on the same line where it opens.

=cut

sub grupkloz_setlits {
    my ($m,$prog,$lihs,$optsr,$nom) = shift->tpuc('grupkloz_setlits',@_);my %opts = $m->ref2hash($optsr);
    my $rank_ignor = $opts{rank_ignor};
    my $lang = $opts{lang} || $m->pvar(lang => 1);
    $m->pstop('need lits hashref for node %n', n => $nom) unless $m->{lits} and 'HASH' eq ref $m->{lits};
    $m->ustop('encountered closer that was not preceded by an opener') unless $nom;
    $m->grupkloz_setvars($optsr,$nom,1) unless $rank_ignor;
    $m->{nom2lits}->{$nom} ||= $m->{lits}; # 單語改動不登錄; 信息可省、用 A2E::Grup 將無
    $m->{nom2gvars}->{$nom} = undef; # at least this dead weight can be discarded
    my $sup = $m->{lits}->{__sup};
    my $fsup = $m->{lits}->{__fsup};
    if ($sup and not $fsup) {
      $m->pwarn('unregistered parent node %p of node %n', p => $sup, n => $nom) unless $m->{nom2lits}->{$sup};
      $m->{lits} = $m->{nom2lits}->{$sup}; # nom2lits_kloz
      $m->pwarn('parent node %p of node %n does not know itself, we are outside all groups', p => $sup, n => $nom) unless $m->{lits}->{__nom};
      $m->{lits}->{__lini} = 0; # ensure that multilingual source with @slngs starts afresh
    } else {
	$m->{lits}->{__fsup} = 0 if $fsup;
	$m->{lits} = {}
    };
    $m->dpop1($prog,$sup);
};

=head4 Function gruplini

Assign a line to the next textchunk.

The line is normally a mere leaf without its own $m->{lits} struct.
In the case of GLINGRUP (cf below) the line itself becomes a $m->{lits} struct with leaf children

GLINGRUP:
    Assign parts of a line to the next textchunk hierarchy.  E.g.

    |John|25|
    |Jane|24|

    should mean the same as

    (
    John
    25
    )
    (
    Jane
    24
    )
    
    Processing depth should depend on a variable C<_lvlmax>

=head5 Subroutine gruplinisplit

Try to split lines and store result into @flds for processing as a group.

    args := val, lvlmax, frm0+
    rets := lvlmax, fld+
    val => 'Odi et amo.  Quare id faciam?  Fortasse requiris.  Nescio!  Sed fieri sentio.  Et excrucior!'
    lvlmax => 1
    lvlmax :: level up to which structured expressions like ||nom|+a+b+c||klav|+c+d+e| are to be split if no other operator than lvlmax is given.  This can be obtained both from outside the function and from frm0+ and thus must be handed back in rets.
    frm0+ =>  +proc+linioi_spi+lrsplit+sentsplit+
    frm0 :: list of which the last to elements are an operator and a value, see operators below. 
    fld+ => |Odi et amo.|Quare id faciam?|Fortasse requiris.|Nescio!|Sed fieri sentio.|Et excrucior.|

Use operators

    split
    match
    lsplit
    rsplit
    lrsplit
    lvlmax

which can be specified at the end of the formatter information of one node, e.g.

    sentsplit = ([.!?:])\s+([[:upper:]])
    @sent = /proc+linioi_spi+lrsplit+sentsplit/

    (verse @sent
    Odi et amo.  Quare id faciam?  Fortasse requiris.  Nescio!  Sed fieri sentio.  Et excrucior!
    )

This will split the line into a group of textchunks instead of treating it as as a single textchunk.
The work is not done by the formatter.
The formatter is receiving the C<+lrsplit+sentsplit+> arguments but we may also later decide to suppress these pseudo-formatter-arguments after splitting is done.

If separation is not successful, return nothing, not even lvlmax.

=cut

our %frml_verb_tab = ();$frml_verb_tab{$_} = 1 for 'proc', 'vok';
# lvlmax treated as a special case, not true but only defined
our %splitil_tab = ();$splitil_tab{$_} = 1 for 'split', 'match', 'lsplit', 'rsplit', 'lrsplit';$splitil_tab{lvlmax} = 0; 

sub gruplinisplit {
    my ($m,$prog,$lihs,$optsr,$val,$lvlmax,@frmtup) = shift->tpuc('gruplinisplit',@_);
    # val => 'Odi et amo.  Quare id faciam?  Fortasse requiris.  Nescio!  Sed fieri sentio.  Et excrucior!'
    # lvlmax => 1
    # @frmtup => ('proc', 'linioi', 'lrsplit', 'splitsent')
    do { $m->decho('no formatter info available for text %v', v => $val);return $m->dpop($prog) } unless @frmtup;
    my $ftval = '';
    my $ftnom = '';
    my $splitil_p = 0; # found parameter is a regex-based splitter with value 1 in %splitil_tab
    my $splitil_defp = 0; # found parameter is a splitter registered in %splitil_tab
    my @frmtup_rest = (); # unused formatter parameters
    $m->ustop('uneven number %d of formatter arguments in %f', d => (1 + $#frmtup), f => $m->koniug_et(@frmtup)) unless 1 == $#frmtup % 2;
  FTNOMVALS: {
    NOOPT: {
	last if 1 < $#frmtup; # more than two elements in the formatter commandline, we can go on
	$m->uwarn('invalid formatter verb %v', v => $frmtup[0]) unless $frml_verb_tab{$frmtup[0]};
	last FTNOMVALS;
      };
      $ftval = pop @frmtup;
      $ftnom = pop @frmtup;
    DEFP: {
	$splitil_p = $splitil_tab{$ftnom};
	$splitil_defp = defined $splitil_p;
	last unless $splitil_defp;
	last FTNOMVALS;
      }
      push @frmtup_rest, $ftnom, $ftval;
      redo FTNOMVALS;
    };
    return $m->dpop($prog) unless $splitil_p;
    push @frmtup, @frmtup_rest;
    my $frmer = [ @frmtup ];
    my @flds = ();
  SPLITIL: { # use regex variables specified with formatter pseudo-arguments 'lrsplit' etc
      last unless $splitil_p;
      my $regex = $lihs->getstr($ftval);
      $m->ustop('unknown regex variable %v', v => $ftval) unless $regex;
    TRY: {
      MATCH: {
	  last unless $ftnom eq 'match';
	  (@flds) = $val =~ m($regex);
	  last TRY;
	};
      SPLIT: {
	  last unless $ftnom eq 'split';
	  (@flds) = split m($regex), $val;
	  last TRY;
	};
      LSPLIT: { # split with a splitter containing a matching suffix part that is appended to the left side element
	  # useful for splitting sentences with ([.!?])\s+
	  last unless $ftnom eq 'lsplit';
	  my ($fld, @rest) = split m($regex), $val;
	FLDS: {
	    last unless $fld;
	    while (@rest) {
		$fld .= shift @rest;
		push @flds, $fld;
		$fld = shift @rest;
	    };
	    last unless $fld;
	    push @flds, $fld;
	  }; # JOIN;
	  last TRY;
	  }; #LSPLIT
      RSPLIT: { # split with a splitter containing a matching prefix part that is prepended to the right side element
	  # added for symmetry with LSPLIT, no use envisaged so far
	  last unless $ftnom eq 'rsplit';
	  my ($fld, @rest) = split m($regex), $val;
	FLDS: {
	    last unless $fld;
	    push @flds, $fld;
	    while (@rest) {
		$fld = shift @rest;
		$fld .= shift @rest;
		push @flds, $fld;
	    };
	  };
	  last TRY;
	}; #RSPLIT
      LRSPLIT: { # split with a splitter containing a matching prefix part that is appended to the left and one that is prepended to the right side element
	  last unless $ftnom eq 'lrsplit';
	  my ($fld, @rest) = split m($regex), $val;
	FLDS: {
	    last unless $fld;
	    while (@rest) {
		$fld .= shift @rest;
		push @flds, $fld;
		$fld = shift @rest;
		$fld .= shift @rest;
	    };
	    last unless $fld;
	    push @flds, $fld;
	  };
	  last TRY;
	}; #LRSPLIT
	$m->pstop('invalid line separator frm0nom %n', n => $ftnom);
      }; #TRY
      $m->ustop('no records found by %n %v on line %l', n => $ftnom, v => $ftval, l => $val) unless @flds; 
      return $m->dpop($prog,$lvlmax,$frmer,@flds);
    };
  LVLMAX: {
    FT: {
	last unless $ftnom eq 'lvlmax';
	$m->pstop('lvlmax %l must be integer between 1 and 3 but is %v', l => $ftval, v => $val) unless $ftval =~ m(\A[1-3]\Z);
	$lvlmax = $ftval;
      };
      last unless $lvlmax; # split only if lvlmax is present and above zero.
      my $sep;
      ($sep, @flds) = $m->textsep2seplist($val);
      $m->pstop('no records found by separator %x on line %v', x => $sep, v => $val) unless @flds;
      return $m->dpop($prog, $lvlmax, @flds);
    };
    $m->dpop($prog);
};

=head5 Subroutine gruplini_nosplit

Store line into variable without splitting.
If needed evaluate the line.
Do not store in memory but in file only, thus making it inaccessible to template except indirectly via vmethods like litscat
Switch linp instructs putstr to do this, cf file:/adv/perl/A2E/Lihs.pm::linp

=cut

sub gruplini_nosplit { # just store as one line without splitting
    my ($m,$prog,$lihs,$optsr,$nom,$val,$lits) = shift->tpuc('gruplini_nosplit',@_);my %opts = $m->ref2hash($optsr);$lits ||= $m->{lits};
    my $verbose = $m->pvar(verbose => 1);
    $val = $m->grupfill($val, lihs => $lihs) if $lits->{__stat};
    $lihs->putstr($nom => $val, typ => 't', echo => $verbose, linp => 1, %opts);
    $m->dpop1($prog,$val);
};

=head5 my $ok = gruplini_lang_eq_slng_p

Whether the current line in the master source text belongs to our current monolingual version.
If $ok is 0, the line is ignored
If $ok is 1, the line is recorded in the current language $ll vocabulary .lits/l.$ll/$nom
If $ok is 2, the line is recorded in the master soruce vocabulary .lits/$nom

=cut
sub gruplini_lang_eq_slng_p {
    my ($m,$prog,$lihs,$sup,$lang,$flng) = shift->lpuc('gruplini_lang_eq_slng_p',@_);
    my $lini = $m->{lits}->{__lini}++;
    my $lini0 = $m->{lits}->{__lini0}++; # glini_lang_eq_flng
  FLNG: { # glini_flng:  special treatment for monolingual source files
      last unless $flng;
      my $ok = $flng eq $lang;
      return $m->dpop1($prog,$ok);
    };
    my @slngs = $m->grupvars_getlst($lihs, slngs => $sup); # ('zh','de')
    my $LX = $m->grupvars_getval($lihs, LX => $sup) || 'LX'; # local LinguaFranca
    my $nlngs = scalar @slngs;
    my $ll2ok = sub { my $ll = shift;if (grep { $_ eq $ll } $lang, '1LL') { 1 } elsif ($LX eq $ll) { 2 } };
  NLNGS: { # in monolingual doc we do not need to check
      last if $nlngs > 1;
      my $ok = &$ll2ok($slngs[0]);
      return $m->dpop1($prog,$ok);
    };
  SLNG1: { # directive slng1 make the current field (lit) monolingual.  Rules with special enumerated arguments can be used to make some fields of a table monolingual
      # e.g.: slng1 = $(case ${2},1,[cd],0)
      # ${1} is current fol, e.g. '_a_c', in which case ${2} is 'a_c', ${3} is 'a' and ${4} is 'c'
      my $slng1 = $m->grupvars_getval($lihs, slng1 => $sup); # OLD 200921: my $slng1 = $m->grupvars_getval($lihs, slng1 => 0);
      last if ! defined $slng1;
      # slng1 may be a complex expression e.g. $(case|${2}|0|(?:num|kap)|1)
      my $fol1 = $m->{lits}->{__fol}; # _kap_val
      my ($fol2) = $fol1 =~ m(\A\_?([a-z]\w*)\Z); # kap_val
      my @span = split '_', $fol2; # qw/kap val/
      $slng1 = $m->{sarb}->val_args_call($slng1,undef, $fol1, $fol2, @span); # ${1} => _kap_val, ${2} => kap_val, ${3} => kap, ${4} => val
      last if ! $slng1;
      my $linilang_div = 1+ int $lini / $nlngs; # line number assuming we are operating in mutilingual mode;
      last if $slng1 > $linilang_div; # start with multilingual lines: file:/phm/19/06/24/sig/_lng.phm_pub_sig190624.txt::linilang
      $m->{lits}->{__lini0} = 0;
      return $m->dpop1($prog,1);
    };
    my $linilang_mod = $lini0 % $nlngs;
    my $linilang = $slngs[$linilang_mod];
    my $ok = &$ll2ok($linilang);
    $m->decho('ignoring source language %l other than %L', l => $linilang, L => $lang) unless $ok;
    $m->dpop1($prog,$ok);
};
sub gruplini {
    my ($m,$prog,$lihs,$optsr,$val) = shift->tpuc('gruplini',@_);my %opts = $m->ref2hash($optsr);
    my $sup = $m->{lits}->{__nom};
  IGNORP: {
      my $ignorp = $m->grupvars_getstr($lihs, ignorgrup => $sup);
      last if ! $ignorp;
      return $m->dpop($prog);
    };
    $m->pstop(nogruplini => 0) if !$sup;
    my $lang = $m->pvar(lang => 0);
    my $kontp = 1; # do move the counter in upcoming set_nom_fols
    # enable conditional multiline multilinguality, e.g. "[]\t20V\n[zh] 20伏\n" 
    # when a ltrx expression has [.*] followed by space other than ' ' (e.g. '  ', "\t") we parse another line
    my $ltrxp = 0; # do not treat as selected by ltrxpars (but rather just cycle $lang through @slngs)
    my $glngp = 0;
  SLNGP: {
    LTRXPARS: { # parse language selector marks in source text e.g. ^[]
	# lang sel regex, first use file:/sig/oas/20/07/ecodX7/tra/wart/_lng.ecodX7_wart.txt
	my $ltrx = $lihs->getval('ltrx');
	$ltrx = $ltrx ? qr($ltrx) : qr(\A\[(.*)\](\s+)(.*)\Z);
	my ($lrx,$spc,$sv) = $val =~ m($ltrx);
	last if ! $sv; # no language selector found, go on cycling through @slngs
	$val = $sv;
	if (!$lrx) {
	    $ltrxp = 1;
	} elsif ($lrx =~ m(\A\w+\Z)) {
	    $ltrxp = $lang eq $lrx;
	} elsif ($lrx =~ m(\A\w.*\w\Z)) {
	    my @ll = split m(\W), $lrx;
	    $ltrxp = grep { $_ eq $lang } @ll;
	} else {
	    $lrx = qr(\A$lrx\Z); # /\A.*\Z/
	    $ltrxp = $lang =~ m($lrx);
	};
	return $m->dpop($prog) if ! $ltrxp; # language selector match e.g. [zh] resulted in 0, nothing to read here, leave
	last unless $ltrxp;
	$kontp = $spc eq ' ';
	$m->{lits}->{__lini0} = 0;
	last SLNGP;
      };
      $glngp = $m->gruplini_lang_eq_slng_p($lihs,$sup,$lang,$optsr->{flng}); # gruplini_glngp
      last if $glngp;
      return $m->dpop($prog);
    };
    $opts{flng} ||= $lang if $glngp == 1; # not for LX;
    my $set_nom_fols = sub {
	my $num = ++$m->{lits}->{__num};
	my $fol = $m->supnum2fol($sup,$num);
	my $nom = $sup . $fol;
	$fol = '~' . $fol;  # '~' notation signifies suffixness
	if ($m->{lits}->{__folp}->{$fol}) {
	    $m->uwarn(folinnfols => f => $fol, F => $m->{lits}->{__fols}, n => $nom);
	} else {
	    push @{$m->{lits}->{__fols}}, $fol;$m->{lits}->{__folp}->{$fol} = 1;
	};
	return $nom, $fol;
    };
    my $nom = '';
    my $fol = '';
  KONTP: {
      last unless $kontp;
      ($nom, $fol) = &$set_nom_fols;
      last unless $ltrxp; # persistent storage needed to save nom and fol for trailing members of ltrxpars i.e. "[] ...\n[zh]\t..." linegroup
      ($m->{slits}->{__nom}, $m->{slits}->{__fol}) = ($nom, $fol);  # store subbranch info in slits, separate from lits; 
    };
  NKONTP: {
      last if $kontp; # from here on we are in a trailing member of ltrxpars linegroup
      ($nom, $fol) = ($m->{slits}->{__nom}, $m->{slits}->{__fol}); # read prestored subbranch info 
    };
  NOMFOLCHK: { # 201001 help debug new LTRXPARS/KONTP/NKONTP syntax
      last if $nom and $fol;
      $m->pstop('unable to assign nom and fol to in grup %n to line reading %v', n => $m->{lits}->{__nom}, v => $val); 
    };
    my $glingrup = sub { # treat line as line or as something to split into a group
	# Decide whether each line is really a single line or a group that needs to be split into chunks by a given splitter, and process accordingly.
	# cf old stuff at file:/phm/15/02/07/sig/old_glingrup.pl
	my @flds = ();
	my $get_frmt = sub {
	    # block nom7frmt: read special textchunk variable like @top_frm, @ul_frm or fallback @frm
	    # Use value of this variable, which typically refers to simple formatter table consisting of one level of lines such as C<@frm = /proc+linioi_spi/>.
	    my $frmt = shift;
	    return $frmt if $frmt;
	  FOL2FRMT: {
	      last if !$fol or $fol =~ m(\A\~\d);
	      $m->vecho(nofrml => n => $nom);
	      my $frmnom = $nom . '_frm';
	      $m->decho(frmnom => f => $frmnom);
	      $frmt = $lihs->getstr($frmnom);
	      return $frmt if $frmt;
	    };
	  VAR2FRMT: {
	      $frmt = $lihs->getstr('ll');
	      return $frmt if $frmt;
	    };
	    $m->ustop(gnofrml => g => $nom);
	};
	my $frmt = &$get_frmt($m->{lits}->{__frm});
	my $frmlr = $m->str2arb($frmt);
	my @frml = $m->ref2list($frmlr);
	$m->pstop(glingruperef => n => $nom) if !@frml;
	shift @frml; # ([ 'proc', 'linioi', 'lrsplit', 'sentsplit' ], [ 'call', 'quote' ])
	my $setfrmlr = sub {
	    return if ! @frml;
	    my $lvlmax = $m->{lits}->{__lvlmax};
	    $lvlmax-- if $lvlmax;
	    my $frmer = $frml[0];  # => [ 'proc', 'linioi', 'lrsplit', 'sentsplit' ];
	    $m->pstop(badfrmer => r => $frmer, t => \@frml) unless 'ARRAY' eq ref $frmer;
	    ($lvlmax,$frmer,@flds) = $m->gruplinisplit(\%opts,$val,$lvlmax,@$frmer); # split only if told to so so by $frmer
	    return if ! @flds;
	    $frml[0] = $frmer; # remove trailing linesplitter pseudo-arguments from frml (?)
	    (\@frml, $lvlmax, @flds);
	};
	($frmlr,my $lvlmax,@flds) = &$setfrmlr;
	return $m->gruplini_nosplit(\%opts,$nom,$val) if ! $frmlr;
	my $grupopen = sub {
	    $m->{lits} = $m->{nom2lits}->{$nom} || {};
	    $m->pstop(nomlits => n => $nom, l => $m->{lits}) unless 'HASH' eq ref $m->{lits};
	    $m->lits_put_atr(__fin => 0); # definition section opening
	    $m->{lits}->{__lini} = 0;
	    $m->{lits}->{__num} = 0;
	    $m->{lits}->{__nom} = $nom;
	    $m->{lits}->{__sup} = $sup;
	    $m->{lits}->{__lvlmax} = $lvlmax if $lvlmax;
	    $m->grupopen_frmt_fols_set_lsts_hacs($nom,$frmt,\%opts);
	};
	&$grupopen;
	my $subgrup = sub {
	    foreach my $fld (@flds) { $m->gruplini($optsr,$fld) };
	    1;
	};
	&$subgrup;
	my $grupkloz = sub {
	    $m->lits_put_atr(__fin => 1); # definition section closed
	    ($nom) = $m->grupkloz_setlits($optsr,$nom);
	    1;
	};
	&$grupkloz;
    };
    &$glingrup;
    $m->dpop1($prog,$nom);
};
 
=head4 Function lits_tfol2nom

Derive the absolute lit name from the relative/leaf form, especially in trees like

    (p2pat
    (konfus proc+titenumlist
    lab = Verwirrung
    =0 = Verwirrend erscheint insbesondere,
    + = dass die Involvierung von externen Freiwilligen den Geheimnisschutz verbessern soll
    )
    )

when invoked with '+*0', based on available $m->{lits} tree, return 'p2pat_konfus0'.

Synopsis

    args := tfol, lits?
    rets := nom, fol, typ
    tfol => '@hi'
    tfol :: prefixed leaf for which to derive absolute name; returned version contains resulting fixed value '=1' instead of '+' or '-'
    typ => '@'
    fol => 'hi'
    fol :: leaf without prefix
    fol => =0 ; mov => =, fol => 0
    fol => + ; mov => +, fol =>
    fol => _tit; mov =>, fol = _tit
    fol => +_des; mov => +, fol = _des
    lits :: hierarchy tree info to use, defaulting to $m->{lits}
    nom :: textchunk name
    nom => p2pat_konfus0	
    typ => '@'
    typ :: variable type prefix, @ for list, % for hash

This function interprets prefixes like '+' and '_' in order to decide how to build the variable name so that the function as sketched in dok:adv_pub_litscat1004.

dont confuse with lit_fol2om

=cut

sub lits_tfol2nom {
    my ($m,$prog,$s,$lits) = shift->ppuc('lits_tfol2nom',@_);
    my ($typ, $fol) = $s =~ m(\A([@%]?)(\w*)\Z);
    $lits ||= $m->{lits};
    my $sup = $lits->{__nom};
    my $nom = $fol;
    $typ ||= '$';
    return $m->dpop($prog,$nom,$sup,$fol,$typ) if !$sup;
    $nom = $sup . '_' . $fol;
    $m->dpop($prog,$nom,$sup,$fol,$typ);
}

=head4 Function grupkorp

Move from the header to the body of a group in response to '!' or '?' which is given as argument.
Just set the state for processing of text body lines which is done later in gruplini.

=cut

sub grupkorp ($+$;) {
    my ($m,$prog,$lihs,$optsr,$fin,$stat) = shift->tpuc('grupkorp',@_);my %opts = $m->ref2hash($optsr);my $gvars = $optsr->{gvars} || $m->{grupvars};
    my $ignor = $opts{rank_ignor} || $m->{lits}->{__ignor};
    $fin ||= ''; # '?' or '!'
    $stat ||= ''; # ':' or ''
    my $nom = $m->{lits}->{__nom};
    $m->ustop('found body opening symbol line %f outside a group', f => $fin) unless $nom;
    my $ll = $m->pvar(lang => 1);
  SETLITSFIN:{
      # __fin signals that body lines are to be read rather than ignored
      $m->pstop('nolitsfols') if 'ARRAY' ne ref $m->{lits}->{__fols}; # nofolsstop
      my $nfin = do { if ($ignor or @{$m->{lits}->{__fols}} and $fin eq '?') { $m->{lits}->{__ignor} = 1;2 } elsif ($fin eq '!') { @{$m->{lits}->{__fols}} = ();1 } else { 0 } }; 
      $m->lits_put_atr(__fin => $nfin);
      $m->lits_put_atr(__stat => 1) if $stat eq ':';
      $m->lits_put_atr(__lini => 0);
    };
    $m->grupkloz_setvars($optsr,$nom,0);
  INCLUDE: {
      last unless $m->{lits}->{__vars}->{include}; # avoid reinvocaton by lower levels: file:/phm/18/09/02/sig/_lng.phm_pub_sig180902.txt
      my $fayl = $gvars->{include};
      last unless $fayl;
      $gvars->{include} = undef;
      # delete $m->{grupvars}->{include};delete $m->{lits}->{include}; # kludge /phm/18/09/02/sig/_lng.phm_pub_sig180902.txt
      $m->uwarn(fginclude => g => $nom, f => $fayl);
      $m->lits_put_atr(__fin => 0); # file:/phm/19/06/19/sig/_lng.phm_pub_sig190619.txt::ifin include_fin0: allow included document to begin with assignments
      $m->riid_tmplvars_fayl($fayl, sup => $nom, insistp => 1, %opts);
      return $m->dpop1($prog,1);
    };
    $m->dpop1($prog,1);
};
=head4 Function debug_litnom

In grupsynt, switch on debugging if current textchunk is one of DEBUG_LITNOMS.

=cut

sub debug_litnom {
    my ($m,$prog,$lnom) = shift->ppuc('debug_litnom',@_);
    return $m->dpop($prog) unless $m->{debug_litnoms};
  TRY: {
    OFF2ON: {
	last if $m->{debug};
	last unless grep { $_ eq $lnom } @{$m->{debug_litnoms}};
	$m->{debug} = $lnom;
	last TRY;
      };
    ON2OFF: {
	last unless $m->{debug} eq $lnom;
	last if grep { $lnom =~ m(\A\_) } @{$m->{debug_litnoms}};
	$m->{debug} = '';
	last TRY;
      };
    };
    $m->dpop1($prog,$m->{debug});
};

=head4 $m->grupsynt(\%opts,$lini,$s) => $ok

Check whether we have group related syntax and if so process it and return true.
Analogous to tmplini_kondsynt.

    args := lini, lini_nokoment, ignor, opts
    rets := ok
    lini :: whole line
    lini_nokoment :: line with everything after '#' removed
    ignor :: we are in a low-rank unexport-level file e.g. a @lng.*.txt files of a superordinate directory and therefore ignore everything that is in a group except for variable assignments marked with C<export>
    opts :: options for tmplini et al which are passed down all the way to $lihs->putstr/getval
    
=cut

our $orglvl = 0; # 從此以上不再使用文段括弧而唯靠組織模式記法 file:/phm/22/07/15/sig/_lng.phm_pub_sig220715.txt::ankvsnom
undef $orglvl; # 整數型但平時無値
sub grupsynt {
    my ($m,$prog,$lihs,$optsr,$lini,$s) = shift->tpuc('grupsynt',@_);my %opts = $m->ref2hash($optsr);local $_ = $s;
    my $rank_ignor = $opts{rank_ignor};
    my $nom = $m->{lits}->{__nom};
    my $fol = $m->{lits}->{__fol};
  NONKORP: { # Block Nonkorp 
      # We are not yet in a text body
      last if ! $nom; # without $nom we are outside any group anyway
      last if $m->{lits}->{__fin} and not ($orglvl && m(\A\*)); # with __fin we are already in a body and dont need to transit to one, but orgtitpfx1 could mark an end file:/phm/22/07/15/sig/_lng.phm_pub_sig220715.txt::ankvsnom
    NOMVAL: { # set an attribute in normal syntax
	my @nomval = m($m->{qre}->{setnomval});
	last if ! @nomval;
	$m->tmplini_setnomval($optsr,@nomval);
	return $m->dpop1($prog,1);
      };
    ORGTIT: { # process org-mode title line e.g. "** DONE <<ffpcY2>> FFP2-Masken :covid19"
	my $get_ank_tit = sub { # check possible org-style title line syntax, extract anchor $ank and title $tit
	    my ($pfx, $tut) = m(\A(\*+)\s+(\S.*)\s*\Z); # $tut is whole headline with or without anchor <<$ank>>
	    return unless $tut;
	    my ($tds, $ank, $tit) = $tut =~ m(\A(TODO|DONE|)\s*\<\<(\w+)\>\>\s*(.*)\Z);
	  TUTANKTIT: { # [[file:/phm/22/08/10/sig/_lng.phm_pub_sig220810.txt::tutanktit][允許組織模式中簡略標題]]
	      last if $ank;
	      $m->ustop('Fehlender Anker in Org-Sektionstitel %t', t => $tut) unless $tut =~ m(\A\w+\Z);
	      $ank = $tut;$tit = $tut;
	    };
	    my $lp = length $pfx;
	  ANKVSNOM: { # 不帶括弧而光以組織模式記法開啟新文段 file:/phm/22/07/15/sig/_lng.phm_pub_sig220715.txt::ankvsnom
	      last if $nom eq $ank or $fol eq $ank;
	      $m->pwarn(ankvsnom => a => $ank, n => $nom);
	    GRUPKORPKLOZ: { # file:/phm/22/08/01/sig/_lng.phm_pub_sig220801.txt::sektrek
	      SUPGRPKORPKLOZ: { last unless $m->{lits}->{__lvl} > $lp; # 回到上層
				while ($m->{lits}->{__lvl} > $lp) {
				    $m->grupkorp($optsr, '!') unless $m->{lits}->{__fin};
				    $m->grupkloz($optsr,')');
				} 
				last GRUPKORPKLOZ;
		}; # 下層内容開始了
		$m->grupkorp($optsr, '!');
	      };
	      $m->ustop('trying to descend to litslvl %l in a pure org-mode that started at orglvl %o', l => $m->{lits}->{__lvl}, o => $orglvl) if defined $orglvl and $orglvl > $m->{lits}->{__lvl};
	      $orglvl ||= $m->{lits}->{__lvl}; # the level below which no more brackets are used for grouping but only org-mode headings
	      $m->grupopen($optsr,'('.$ank);
	    };
	    # $m->opts_setnomval($optsr, tds => $tds) if $tds;
	    my $sl = $m->{lits}->{__lvl} - 1;	    
	    $m->ustop('headline prefix %p has %n stars but we are at section level %l', p => $pfx, n => $lp, l => $sl) if $sl ne $lp;
	    ($ank, $tit);
	};
	my ($ank, $tit) = &$get_ank_tit;
	last unless $ank;
      TITSUB: { # strip possible org tags at end of title
	ANKTIT: { # org title line must have anchor $ank. $ank becomes title $tit if not specified.  no more checks in that case
	    last if $tit;
	    $tit = $ank;
	    last TITSUB;
	  };
	  my ($tit0,$tags) = $tit =~ m(\A(.*\s[^:]+)\s+(\:[\w\:]+\:)\Z);
	  $tit = $tit0 || $tit;
	  $tit = $m->grupfill($tit, lihs => $lihs);
	  # $m->opts_setnomval($optsr, tags => $tags) if $tags;
	};
      OPTS_K2V: { 
	  my %k2v = (tit => $tit);
	  $k2v{lab} = $ank if $lihs->getval(org_ank2lab => 1);
	  while (my ($k,$v) = each %k2v) { 
	      $m->opts_setnomval($optsr, $k => $v);
	  };
	};
	return $m->dpop1($prog,1);
      };
    ORGPROP: { # allow special syntax of org-mode property section
	my ($s) = m(\A\s*\:(PROPERTIES|END)\:);
	last unless $s;
	return $m->dpop1($prog,1);
      };
    ORGTUP: { # allow special syntax of org-mode property tuple
	my ($k, $v, $lim) = m(\A\s*\:([@%]?\w+)\:(.*)(.)\Z);
	last unless $k;
	$m->ustop('tuple has key %k and value %v but ends in %l rather than colon', k => $k, v => $v, l => $lim) unless $lim eq ':';
      ANKNOM: { # allow orgtup values to contain links like, :sde:[[file:....][AvlMR]]]: or [[AvlMR]] or [[file:...][2020-04-05]], 見file:/phm/22/04/01/sig/_lng.phm_pub_sig220401.txt::anknom
	  my ($nom) = $v =~ m(\A\[\[(.*)\]\]\Z);
	  last unless $nom;
	  do { $v = $1;last } if $nom =~ m(([^\133]+)\Z); # everything behind the last '\133' = asc 13x8+3 = 91 = sqbrak0, cf file:/phm/22/05/01/sig/_lng.phm_pub_sig220501.txt::anknom
	};
	$m->opts_setnomval($optsr,$k,$v);
	return $m->dpop1($prog,1);
      };
    ORGPLAN: { # allow special syntax of org-mode planning info tuple
	my ($k, $v) = m(\A\s*(SCHEDULED|DEADLINE|CLOSED|PRIORITY)\:\s*(.*)\s*\Z);
	last unless $v;
	$m->opts_setnomval($optsr, $k, $v);
	return $m->dpop1($prog,1);
      };
    KORPSTART: {
	my @korpstart = m(\A([?!])([:]?)\Z);
	last unless @korpstart;
	$m->grupkorp($optsr, @korpstart);
	return $m->dpop1($prog,1);
      };
      # we are entering a body anyway, but implicitely, without returning, with need to go on parsing this line as first line of body
      $m->grupkorp($optsr, '!');
    };
  OPENKLOZ: { # Smettiamo di parsare se stiamo aprendo o chiudendo un gruppo oppure se restiamo fuori del gruppo.
      my $ok = '';
      my $nom2 = '';
      my $ch = substr $_, 0, 1;
    OPEN: { # NEWSUBGRUP 似乎應開啟下屬物體 file:/phm/19/05/22/sig/_org.phm_pub_sig190522.txt::newsub
	last if $ch ne '(';
	($ok,$nom2) = $m->grupopen($optsr,$_);
	$m->ustop(litnom_p => k => $nom2) if $nom2 =~ m(\_\Z) or $nom2 =~ m(\A\_);
	last OPENKLOZ if ! $ok;
	$m->debug_litnom($nom2);
	return $m->dpop1($prog,1);
      };
    KLOZ: {
	last if $ch ne ')';
      ORGKLOZ: { # 
	  last unless defined $orglvl;
	LVLTRO: { # level exceeds orglvl
	    my $lvl = $m->{lits}->{__lvl};
	    last unless $lvl > $orglvl;
	    $m->grupkloz($optsr,')');
	    $m->pstop('grupkloz failed to reduce level %l', l => $lvl) unless $m->{lits}->{__lvl} < $lvl;
	    redo LVLTRO;
	  };
	};
	($ok, $nom2) = $m->grupkloz($optsr,$_);
	$orglvl = undef;
	last OPENKLOZ if ! $ok;
	$m->debug_litnom($nom2);
	return $m->dpop1($prog,1);
      };
    };
  NONOM: { # Subblock Nonom
      #if we are neither in a text group nor opening a new one, we conclude group syntax parsing unsuccessfully
      last if $nom;
      return $m->dpop1($prog,0);
    };
  FINLINI: { 
      # Text body lines are treated with trailing comments not removed, assuming that they could be from quote/verbatim environments and that if we write inline comments ourselves we have better syntactical means for that, e.g. C<$(koment|comment text|1)> evaluating to C<1> only.
      last unless $m->{lits}->{__fin};
      $m->gruplini($optsr,$lini) if $m->{lits}->{__fin} == 1;
      return $m->dpop1($prog,1);
    };
    $m->pwarn(gnopars => s => $_, n => $nom, l => $m->{lits});
    $m->dpop1($prog,0);
};

=head4 Function sfx2fun

Given

    ahval = [[$(value ${1}_url)][$(or ${2}${3}${4},$(value ${1}_tit))]!]
    %sfx2fun = ||url|+call+ahval+1+2+3+||call|+call+||proc|+proc+|

Set implicit functions triggered by suffixes (sfx) such as 'url'.

EBNF
 
    args := vars, fol
    rets := verb, args
    vars := hashref
    vars :: group variables
    fol := string
    fol => 'xa_url'
    fol :: leaf name of the variable that might trigger an implicit function assignment 
    fol2 => 'xa_ahval_1_2_3_call'
    fol2 :: equivalent of fol    	
    verb :: 'xa'
    args :: 'call', 'ahval', '1', '2', '3'

TODO: ensure that group variable call will finally call a general variable that was defined outside the document

=cut

sub sfx2fun {
    my ($m,$prog,$lihs,$gvars,$fol,%opts) = shift->ogpuc('sfx2fun',1,@_);
    $m->pstop(funnovar => v => 'fol') unless $fol;
    my @fol_args = split '_', $fol;
    my $fol_sfx = pop @fol_args; # e.g. 'url'
    return $m->dpop($prog) unless @fol_args;
    $m->pstop(funnovar => v => 'vars') unless $gvars;
    my $get_sfx2fun = sub {
	my $sfx2fun = $gvars->{sfx2fun};
      SFX2FUN: {
	  last if 'HASH' eq ref $sfx2fun;
	  $sfx2fun = $lihs->{hacs}->{sfx2fun};
	  last if 'HASH' eq ref $sfx2fun;
	  $sfx2fun = $lihs->getstr('sfx2fun');
	  last unless $sfx2fun;
	  $m->pwarn('obtaining sfx2fun from string variable');
	  $sfx2fun = $m->str2arb($sfx2fun);
	};
	if ($sfx2fun) {
	    $m->pstop('nonhash value %v stored under sfx2fun in in hacs', v => $sfx2fun) unless 'HASH' eq ref $sfx2fun;
	    $gvars->{sfx2fun} = $sfx2fun;
	};
	$sfx2fun;
    };
    my $sfx2fun = &$get_sfx2fun;
    my $fol_verb = shift @fol_args; # e.g. 'xa'
    my $fun = $sfx2fun->{$fol_sfx} or return $m->dpop($prog);
    my @funs = $m->x2list($fun);
    $m->ustop('empty function defined for %x in sfx2fun', x => $fol_sfx) unless @funs;
    push @funs, $fol_verb; # 'xa_1_2_3_url', transmit name, value must be obtained later
    push @funs, @fol_args if @fol_args; # xa_1_2_3_url =>  [ 'call', 'ahurlval_verb', 'xa_1_2_3_url', '1', '2', '3', @_ ] || [ 'call', 'ahurlval_verb', 'sp' ]
    $gvars->{$fol_verb} = [ @funs ]; # $gvars->{xa} = [ 'call', 'ahval', 'xa', 1, 2, 3 ];
    $m->dpop($prog,$fol_verb, @funs);
};

=head3 Naming of Variables

=head4 $m->tmplini_setnomval(...) => ...:

Perform what was recognised by the setnomval regex to be a variable assignment statement.
Take the matched substrings of that regex as arguments, i.e. 
  @args => $opts, $verb, $nom, $nurdefp, $statvar, $val
  $opts => { rank => 1 }
  $verb => 'export'
  $nom => 'tit'
  $nurdefp => '?' :: write only if still undefined; override this by option redefp => 1 thereby in effect switching off the '?' effect
  $kalkop => '+-*/%' :: calculation operator
  $statvar => ':'
  $val => 'Function tmplini_setnomval'
Return the name and value that were used in the assignment.
Return nothing if nothing was assigned.
The return value is unimportant because in either case tmplini ends after this.

=cut

sub lvals2valll {
    my ($m,$prog,$lihs,$lang,$vall,$langl,$sup) = shift->lpuc('lvals2valll',@_);
    my @vals = @$vall;$sup ||= $m->{lits}->{__nom};
    my @langs = 'ARRAY' eq ref $langl ? @$langl : $sup ? $m->grupvars_getlst($lihs, slngs => $sup) : $m->plst(langs => 1);
    my %ll2val = ();
    my $i = 0;
    while ($i <= $#langs) {
	last unless $vals[$i];
	$ll2val{$langs[$i]} = $vals[$i];
    } continue { $i++ };
    my $ll = 'la';
    while ($i < $#vals) { # ||fr|encore une langue||it|ancora una lingua|
	next if $vals[++$i]; # looking for the first empty position ||
	$i++;$ll = $vals[$i];$m->ustop('bad language %l at position %i of %V', l => $ll, i => $i, V => \@vals) unless $ll =~ m(\A\w{2}\Z);
	$i++;$m->ustop('looking for value for language %l at %i beyond end of %V', l => $ll, i => $i, V => \@vals) if $i > $#vals;$ll2val{$ll} = $vals[$i];
    };
    my $val = $ll2val{$lang};
    unless ($val) { $val = $vals[0];$lang = $langs[0] };
    $m->dpop($prog,$val,$lang);
};

sub val2lval { # tit = |特許請求の範囲|Patentanspruchsbereich||zh|權利主張範圍|, 根據 @slngs 或 $opts{langs}, file:/adv/perl/A2E/MLMK.pm.tmpl::val2lval file:/adv/perl/A2E/Tmplfil.pm.tmpl::/\bval2lval\b/
    my ($m,$prog,$lihs,$val,$ll,%opts) = shift->lpuc('val2lval',@_); # $tit, sup => 'rev', langs => ['ja','de']
    return $m->dpop($prog,$val,$ll) unless $val and $ll;
    my $sup = $opts{sup} || $m->{lits}->{__sup};
    my @langs = ();
  LANGS: {
      my $sls = $opts{langs};
      @langs = @$sls if $sls;
      last if @langs;
      @langs = $m->grupvars_getlst($lihs, slngs => $sup);
      last if @langs;
      return $m->dpop($prog,$val,$ll);
    };
    my $langs_nbr = scalar @langs;
    return $m->dpop($prog,$val,$ll) unless $langs_nbr > 1;
    my $sep = substr $val, 0, 1;
    return $m->dpop($prog,$val,$ll) unless $m->arbsepp($sep);
    my $len = length $val;$len--;
    my $sep1 = substr $val, $len;
    return $m->dpop($prog,$val,$ll) unless $sep eq $sep1;
    my @vals = $m->textsep2list($val,$sep);
    ($val,$ll) = $m->lvals2valll($lihs,$ll,\@vals,\@langs,$sup);
    $m->dpop($prog,$val,$ll);
};

sub setvfol { # set functions corresponding to  'vf_url', 'vf_dok', 'vf_proc' and similar when suffixes 'url' and 'dok' are registered in %sfx2fun
    # %sfx2fun = ||url|+call+ahurlval_verb+||dok|+call+ahdokval_verb+||proc|+proc+||call|+call+|
    my ($m,$prog,$lihs,$gvars,$fol,$sup,%opts) = shift->ogpuc('setvfol',2,@_);
    my ($vfol) = $m->sfx2fun($fol,%opts); # 'xa_url' => 'xa'
    return $m->dpop($prog) unless $vfol;
    my $funs = $gvars->{$vfol}; # [ 'call', 'ahurlval_verb', 'xa_url' ]
    $m->pstop(funnovar => v => $vfol) unless $funs;
    my $vnom = join '_', $sup, $vfol; # korp_xa
    my $nom = join '_', $sup, $fol; # korp_xa_url
    $m->{lits}->{__lsts}->{$vfol} = 1;
    my ($vval,$lvlmax) = $m->arb2strl($funs);
    my $litstag = $m->pvar(litstag => 1);
    $opts{lvlmax} = $lvlmax;$opts{litstag} = $litstag;$opts{echo} ||= $m->{debug};
    $lihs->putstr($vnom => $vval, %opts);
    $lihs->{lsts}->{$vnom} = $funs; # redundant but cheap
    $m->dpop1($prog,$vfol);
};
=head4 tmplini_setnomval

redefp :: allow variables to be overwritten when assignement statement contains '?' e.g. tmpl ?= sig; this may be turned off with option redefp which is activated by a plus rank '?+' suffix in file:/adv/perl/A2E/Dokfs.pm.tmpl::no_redefp_rank
 
=cut

sub tmplini_setnomval {
    my ($m,$prog,$lihs,$optsr,$gvars,$setverb,$tfol,$kverklam,$kalkop,$kolon,$val) = shift->tgpuc('tmplini_setnomval',@_);my %opts = $m->ref2hash($optsr);
    my $verbose = $m->pvar('verbose');
    my $rank = -1;
    local $_ = $setverb; # (?:|export|unexport|set), for GNU Make compatibility
    ($setverb) = m(\A(\w+));
    $setverb ||= '';
    my $follp = 0; # whether the leaf ends in our language suffix
    my $lang = $m->pvar(lang => 1);
    my $litstag = $opts{litstag} // $m->pvar('litstag');
    $_ = $tfol; # => '@tmls', 'tit_en'
    my %putopts = ();
    # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
    my $putflng = sub { $putopts{litstag} = 'l';$putopts{litstagarg} = $lang;$putopts{flng} = $lang }; #</nov>
  FOLL2FOL: { # operate on variable name $_, cut off trailing language suffix and return if not my lang
      # file:/phm/19/07/22/sig/_lng.phm_pub_sig190722.txt::foll2fol
      do { &$putflng;last FOLL2FOL } if $opts{flng};
      my $LX = $m->grupvars_getval($lihs, 'LX') || 'LX'; # local lingua franca
      my ($nom,$ifx,$ll) = m(\A([@%]?[a-z,A-Z]\w*[a-z,A-Z])(\_|\d+)(\w+)\Z);
      do { $putopts{flng} = undef;last FOLL2FOL } unless $ll and (grep { $_ eq $ll } 'LL', $LX or $m->{progvars}->{langp} ? $m->{progvars}->{langp}->{$ll} : $ll =~ m(\A[a-z]{2}\Z)); # tfol_langp
      # <nov id=folnoll orl="file:/phm/21/03/11/sig/_lng.phm_pub_sig210311.txt::mlht">
      return $m->dpop($prog) unless grep { $_ eq $ll } $lang, $LX, 'LL';
      # </nov id=folnoll>
      # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
      &$putflng unless $LX eq $ll; # </nov>
      $tfol = $nom;
      $tfol .= $ifx if $ifx =~ m(\A\d); 
      $follp = 1; # whether lingual leaf cf file:/phm/20/10/06/sig/_log07adv.phm_pub_sig201006.txt::95298
    };
    my ($nom, $sup, $fol, $typ) = $m->lits_tfol2nom($tfol); # 'top_tmls', 'top', 'tmls', '@'
    $val = $lihs->chkvar($nom,$val);
    $m->ustop(lituaz => k => $nom) if $nom =~ m(\_\Z) or $nom =~ m(\A\_) or $nom =~ m(\_\_);
    $lihs->{vars}->{__litnom} = $nom; # to help debugging messages
    return $m->Wpop0($prog, p => 'noreahac',n => $nom, v => $typ.$nom) if $m->{lihs}->{hacs}->{$nom} and $typ ne '%';
    return $m->Wpop0($prog, p => 'norealst', n => $nom, v => $typ.$nom) if $m->{lihs}->{lsts}->{$nom} and $typ ne '@';
    return $m->Wpop0($prog, u => 'noovwrp', n => $nom, v => $lihs->getval($nom), w => $val) if $m->{progvars}->{$nom};
    # return $m->Wpop0($prog, u => 'noovwra', n => $nom, v => $lihs->getval($nom), w => $val) if $lihs->{hacs}->{_antevarp_}->{$nom};
  RANK: {
      do { $rank = $TMPLVARS_FAYL_RANKS{important};$opts{redefp} = 1;last } if $opts{rank} eq '+';
      do { $rank = $TMPLVARS_FAYL_RANKS{unimportant};last } if $opts{rank} eq '-';
      $rank = $TMPLVARS_FAYL_RANKS{normal};
    };
    my $nurdefp = $opts{redefp} ? 0 : $kverklam eq '?' ? 1 : 0;
    my $statvar = $kolon eq ':' ? 1 : 0; # static variable, must be evaluated before storing
    return $m->dpop($prog) unless $setverb eq 'export' or $rank > $TMPLVARS_FAYL_RANKS{unimportant};
    return $m->dpop($prog) if $setverb eq 'unexport' and $rank < $TMPLVARS_FAYL_RANKS{important};
    # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
    # return $m->dpop($prog) if $nurdefp and $lihs->{vars}->{$nom};
    return $m->dpop($prog) if $nurdefp and $lihs->vgetval($nom);
    # </nov>
    _utf8_on $val;
    do { $m->tmplini_special_body($val);return $m->dpop($prog) } if 'special' eq $fol; 
  VAR: { # distinguish static (:=) and dynamic (=) variable assignement
      # <nov orl="file:/phm/21/04/16/sig/_lng.phm_pub_sig210416.txt::statflng">
      do { $val = $m->grupfill($val, lihs => $lihs);$putopts{flng} = $lang } if $statvar; #</nov>
      delete $m->{tmplarbs}->{$nom};
      my $arbp = $lihs->arbtypp($typ);
      $m->setvfol($fol,$sup,%opts) if $sup;
      $putopts{echo} = $verbose;$putopts{litstag} = $litstag;
      $putopts{$_} ||= $opts{$_} for qw(putvars flng);
      my $grupvarp = $m->{lits}->{__nom}; # whether we are in a group i.e. "\A(\n...\n)" section.
      if ($arbp) { # structured variables with prefixes @% stored in $lihs->{lsts} etc 
	  if ('+' eq $kalkop) {
	    SEQPUCQ_KALKOP: $m->seqpucq($nom,$val,%putopts);
	  } else {
	      $val = $m->strval_defarb($lihs,$typ,$nom,$val,%putopts);
	  };
	  if ($grupvarp) { my $treg = $lihs->treg($typ);
			   $m->{lits}->{'__'.$treg}->{$fol} = 1 };
      } else {
	  $m->ustop('variable %n is a list, not a string', n => $nom) if $lihs->{lstp}->{$nom};
	  $m->ustop('variable %n is a hash, not a string', n => $nom) if $lihs->{hacp}->{$nom};
	  my ($lval,$ll) = $m->val2lval($lihs, $val, $lang, sup => $m->{lits}->{__sup}) if !$follp and $m->{konfig}->lvalnomp->{$fol};
	PUTSTR: {
	    # last if $ll ne $lang;
	    if ($ll) { $putopts{litstag} = 'l';$putopts{flng} = $ll;$val = $lval };
	    last if !$val;
	    $lihs->putstr($nom => $val, %putopts);
	  };
	  $m->{lits}->{__vars}->{$fol} = 1 if $grupvarp; 
      };
      # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC"> 可省略乎
      # eval { $lihs->chkvartyp($nom,$val,$fol,$typ,$optsr->{litstag}) };
      # </nov>
      $m->ustop('failed to set variable %n with value %v to type %t: %m', n => $nom, v => $val, t => $typ, m => $@) if $@;
      $gvars->{$fol} = $val if $grupvarp;
    };
  SETVAR_HOOKS: { # activate 'special' variables and the like
	  last unless $m->{setvar_hooks}->{$nom};
	  $m->pstop('setvar hook of %n is not a listref', n => $nom) unless 'ARRAY' eq ref $m->{setvar_hooks}->{$nom};
	  my @hooks = ();
	  foreach my $hook (@{$m->{setvar_hooks}->{$nom}}) {
	      $m->pstop('invalid setvar hook for variable %n', n => $nom) unless 'ARRAY' eq ref $hook;
	      my $hook_opts = shift @$hook;
	      $m->pstop('invalid setvar hook options %h', h => $hook_opts) unless 'HASH' eq ref $hook_opts;
	      my $kmdverb = shift @$hook;
	      my $kmdfun = $m->tmplfil_special_get($kmdverb, lihs => $lihs);
	      $m->pstop('special directive %k not registered', k => $kmdverb) unless $kmdfun;
	      $m->pstop('function body of special directive %k is invalid', k => $kmdfun) unless 'CODE' eq ref $kmdfun;
	      my @kmdargs = map { $m->grupfill($_, lihs => $lihs) } @$hook;
	      my $res = eval { &$kmdfun($m, @kmdargs) };
	      $m->ustop(setvarargs => n => $nom, k => $kmdverb, A => \@kmdargs, e => $@) if $@;
	      next if $res;
	      $m->pwarn('directive %k executed upon setvar %n but mission not completed', k => $kmdfun, n => $nom);
	      push @hooks, $hook; 
	  };
	  @{$m->{setvar_hooks}->{$nom}} = @hooks;
    };
    # <nov orl="file:/phm/20/12/27/sig/_lng.phm_pub_sig201227.txt::varsXC">
    # $m->pwarn('variable name %n with value %v still not set after assignment routine', n => $nom, v => $val) if defined $val and not defined $lihs->{vars}->{$nom};
    $m->{debug} && $m->pwarn('variable name %n with value %v still not set after assignment routine', n => $nom, v => $val) if defined $val and not defined $lihs->{vars}->{$nom} and not $lihs->getval($nom);
    # </nov>
    $m->dpop($prog,$nom,$val);
};
sub opts_setnomval {
    my ($m,$prog,$lihs,$optsr,$nom,$val) = shift->tpuc('opts_setnomval',@_);
    ($nom,$val) = $m->tmplini_setnomval($optsr, '', $nom, '', '', ':', $val);
    $m->dpop($prog,$nom,$val);
};

=head3 Conditional constructions

=head4 Function tmplini_ifsetval

Return 1 and store this in iflevel_vals of iflevel if the condition that we are parsing is true, 0 otherwise.

subroutine of tmplini,

=cut

our %ifsetfun = (
    ifset => sub { $_[0] ? 1 : 0 },
    ifnset => sub { $_[0] ? 0 : 1 },
    ifdef => sub { defined $_[0] ? 1 : 0 },
    ifndef => sub { defined $_[0] ? 0 : 1 } );
sub tmplini_ifsetval {
    my ($m,$prog,$lihs,$verb,$arg,$komp) = shift->lpuc('tmplini_ifsetval',@_);local @_;local $_;
    $m->ustop('conditional verb %v without argument', v => $verb) unless $arg;
    my $valp = 0;
    my ($parg) = $arg =~ m(\A\s*[\x28](.*)[\x29]\Z);# parenthesis argument
    @_ = do { if ($parg) { $m->textsep2list($parg, ',') } else { $m->textsep2list($arg) } };
  GETVAL: {
    IFDEF: {
	last unless $ifsetfun{$verb};
	$m->pstop('extra argument %k in mononomic %v expression', v => $verb, komp => $komp) if $komp;
	@_ = map { $lihs->getstr($_) } @_;
	my $okp = $ifsetfun{$verb};
	$m->pstop('invalid verb %v', v => $verb) if 'CODE' ne ref $okp;
	foreach my $arg (@_) { $valp = &$okp($arg);last if !$valp };
	last GETVAL;
      };
    IFEQS: {
	last if 'ifeqs' ne $verb;
	my ($nom,@args) = @_;
	my $kval = $lihs->getstr($nom);
	$m->pwarn('Empty comparison variable %n', n => $nom) if !$kval;
	$m->pstop('Extraneous arguments in ifeqs: %A', A => \@args) if @args;
	$m->{iflevel_komp}->{$m->{iflevel}} = $kval;
	last GETVAL;
      };
    BINOM: {
	my ($op) = $verb =~ m(\Aif(eq|ne|neq|lt|gt|le|ge)\Z);
	last unless $op;
	my $fun = $m->{tmplfil_kompopfuns}->{$op};
	$m->pstop('unknown comparison operator %o', o => $op) unless $fun;
	# Perl regex Bug: \((.*)\) does not work, [] are needed.	
	@_ = map { $m->grupfill($_, lihs => $lihs) } @_;
	$valp = &$fun(@_) ? 1 : 0;
	last GETVAL;
      };
      $m->pstop('unknown variable check verb %v', v => $verb);
    };
    $m->{iflevel_vals}->{$m->{iflevel}} = $valp;
    $m->dpop1($prog,$valp);
};

=head4 Function tmplini_kondsynt

Identify an if-related statement, process it and return true if this line no longer needs to be processed by any other parsing procedures.

A true result is achieved if either
 - the line was indeed am if-related syntactic statement, or
 - the line belongs to a part of an if-construction that is idle because the condition for its processing is not met (section IFOK)

A true result is returned whenever it is found somewhere along the way.
If the processing goes on all the way to the end, a false result is returned.

All conditional statements are always evaluated even when we are in an idle section because otherwise we would not know when an endif ends our idle section.

=cut
our %ifverbp = (eqs => 1, def => 1, ndef => 1, set => 1, nset => 1, eq => 1, neq => 1, gt => 1, lt => 1, ge => 1, le => 1 );
our %kondverbp = ('else' => 1, elif => 1, endif => 1, case => 1);foreach my $v (keys %ifverbp) { $kondverbp{'if'.$v} = 1;$kondverbp{'elif'.$v} = 1 };
our %kondsepp = (':' => 1, '/' => 1, ';' => 1, '|' => 1);
sub tmplini_kondsynt {
    my ($m,$prog,$lihs,$s) = shift->lpuc('tmplini_kondsynt',@_);local $_ = $s;
  VERBS: {
      last if m(\=);
      my $sep = substr $_, 0, 1;
      # when we are in a group and want to use conditionals, we need to start line with separator ':' or '/', where '/' leads to interpretation of args as regex
      # :ifeqs:lang:
      # :case:de:en:
      # /case/\A(?:zh|ja|ko)\Z/
      # :endif:
      # Outside of groups we can use either this form or the form known from the GNU Make language
      last if $m->{lits}->{__lvl} and !$kondsepp{$sep}; 
      ($sep, $_, local @_) = $m->text2seplist($_);
      last unless $kondverbp{$_};
    IFX: { # check for ifdef, ifndef, ifeqs, ifeq
	last unless m(\Aif(\w{2,4})\Z);
	do { $m->uwarn(pseudokond => c => $_);last } unless $ifverbp{$1};
	# CAUTION: the regex must not catch assignment statements like 'ifeng_url = http://www.ifeng.com'.
	# Conditional processing must come very early in the tmplini processing chain in order to function.
	$m->{iflevel}++;
	my $val = $m->tmplini_ifsetval($lihs,$_,@_);
	return $m->dpop1($prog,1);
      };

=item elif section

Allow C<elif> (else-if) alternatives, using the same verbs as with if.
This goes beyond the Make standard.

The C<elif> statements add a level of complexity to the logic of conditional directives.
binary comparison between perl true (1) and untrue (0) is no longer sufficient in section C<ifnil>.
iflevel_vals of iflevel is set to -1 if a conditional statement (in ifeq or ifeqs) was already executed.
in the ifnil section we make sure that any section where iflevel_vals of iflevel equals -1 is ignored.

=cut
    ELIFX: {
	last unless m(\Aelif(\w+)\Z);
	do { $m->uwarn(pseudokond => c => $_);last } unless $ifverbp{$1};
	last if $m->{iflevel_vals}->{$m->{iflevel}} < 0;      
	do { $m->{iflevel_vals}->{$m->{iflevel}} = -1;last } if $m->{iflevel_vals}->{$m->{iflevel}} > 0;
	$m->tmplini_ifsetval($lihs,'if'.$1,@_);
	return $m->dpop1($prog,1);
      };
=item else section
=cut
    ELSE: {
	last unless m(\Aelse\Z);
	$m->{iflevel_vals}->{$m->{iflevel}} = $m->{iflevel_vals}->{$m->{iflevel}} ? 0 : 1;
	return $m->dpop1($prog,1);
      };

=item case section
=cut
    CASE: {
	last unless m(\Acase\Z);
	last if $m->{iflevel_vals}->{$m->{iflevel}} < 0;
	do { $m->{iflevel_vals}->{$m->{iflevel}} = -1;last } if $m->{iflevel_vals}->{$m->{iflevel}};
	my @kexps = @_;if (' ' eq $sep && 0 == $#_) { ($sep,@kexps) = $m->text2seplist($_[0]) };
	my $kompar = $sep eq '/' ? $m->{kompar_match} : $m->{kompar_equal};
	my $kval = $m->{iflevel_komp}->{$m->{iflevel}};
	$m->{iflevel_vals}->{$m->{iflevel}} = (!@_ or do { my $res = 0;local $_;foreach my $kexp (@kexps) { if (&$kompar($kval,$kexp)) { $res = 1;last } };$res }) ? 1 : 0;
	return $m->dpop1($prog,1);
      };
    ENDIF: {
	last unless m(\Aendif\b); # allow trailing comments so that if... endif can serve as ignored section
	$m->ustop('ended a group where none was open, already at level %d', $m->{iflevel}) if $m->{iflevel} < 1;
	delete $m->{iflevel_vals}->{$m->{iflevel}};
	delete $m->{iflevel_komp}->{$m->{iflevel}};
	$m->{iflevel}--;
	return $m->dpop1($prog,1);
      };
    }; # VERBS
  IFOK: { # check whether we are the idle part of a conditional statement and if so return.
      foreach my $lvl (1..$m->{iflevel}) {
	  next if $m->{iflevel_vals}->{$lvl} > 0;
	  return $m->dpop1($prog,1); # we can jump over this because condition is false at one of the levels
      }
    };
    $m->dpop1($prog,0);
};

=head3 Multiline variable definitions with define .. endef

These variables work like in Make, see section 'Defining Variables Verbatim' of the GNU Make Texinfo manual.

They are similar to the dynamic oneline variables created by single-equal-assignments, but constitute a kind of macros that span several lines, transcend the normal text variable content and usually contain canned directive sequences (e.g. assignments, groups, conditionals) rather than text values.  Their purpose is not to create long text blocks (that is done by grouping at a much later stage) but to reduce redundancy in command writing.  Therefore they are available early at maketext file processing time, not at the time of final text block composition and output formatting.  To achieve this, we store them as compiled trees in $m->{tmplarbs} and not in $m->{lihs}->{[lt]?vars}.

=head4 Function defnsynt

Memorize a multiline definition block from C<define> to C<endef> as known from makefile syntax.  Return nil if there is nothing to memorize.

This function is built like tmplini_kondsynt and grupsynt: it returns true after finding and processing any expression relevant to the syntax in question and, failing that, returns false at the end.

This comes at the beginning of the tmplini parsing chain because it has the effect of disabling all parsing once we are in the body of the definition.

This functionality has not been thouroughly tested.
It was prepared for in v 0.4.0 and seemed to work in dok:eupat.

=over
=item TODO: Test this functionality.
=back

=cut

sub defnsynt {
    my ($m,$prog,$s) = shift->ppuc('defnsynt',@_);local $_ = $s;
    my ($nom) = m(\Adefine\s+(\w+)\Z);
  DEFINE: {
      last unless $nom;
      $_ = $nom;
      $m->ustop(lituaz => k => $_) if m(\_\Z) or m(\A\_);
      $m->{defn}->{__nom} = $_;
      $m->{defn}->{__lst} = [];
      return $m->dpop1($prog,$_);
    };
  ENDEF: {
      my $ok = m(\Aendef\b);
      last unless $ok;
      $nom = $m->{defn}->{__nom};
      $m->ustop(nonendef => undef) unless $nom;
      $m->pstop(nodefnlst => n => $nom) unless 'ARRAY' eq ref $m->{defn}->{__lst};
      my $val = join "\n", @{$m->{defn}->{__lst}};
      my $arb = $m->{sarb}->parse($val);
      $m->{tmplarbs}->{$nom} = $arb;
      %{$m->{defn}} = ();
      return $m->dpop1($prog,$nom);
    };
  BODY: {
      $nom = $m->{defn}->{__nom};
      last unless $nom;
      $m->pstop(nodefnlst => n => $nom) unless 'ARRAY' eq ref $m->{defn}->{__lst};
      push @{$m->{defn}->{__lst}}, $_;
      return $m->dpop1($prog,$nom);
    };
    $m->dpop1($prog,0);
};

=head3 Line Parsing

=head4 Function tmplini_pur

restricted syntax in certain files, such as conversion tables.
we want to use the same function for these tables but without the time-consuming support of various directives and expansion mechanisms.

=cut

sub tmplini_pur {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('tmplini_pur',@_);local $_ = $s;my %opts = $m->ref2hash($optsr);
    my @res = map { qr($_) } split m(\s+), $opts{setnomval};
    push @res, qr{\A(\w+)\s*\=\s*(\S.*)\s*\Z} unless @res;
    my ($nom,$val) = ();
    foreach my $qre (@res) {
	($nom, $val) = m($qre);
	last if $nom;
    };
    return $m->dpop($prog) unless $nom;
    $lihs->putstr($nom => $val, %opts);
    $m->dpop($prog,$nom,$val);
};

=head4 Function tmplini_special
	
Process some special directives that are hooked in by external applications.
A prime example of this is

	special process bautext_tmpl.txt

i.e. a directive to process a template and make the blocks defined therein available to the $(litsproc ...) function.

=cut

sub tmplini_special {
    my ($m,$prog,$s) = shift->ppuc('tmplini_special',@_);local $_ = shift;
    my ($body) = m(\Aspecial\b(.*)\Z);
    return $m->dpop($prog) unless $body;
    $m->ustop('old non-makefile syntax no longer supported, rewrite as pseudo variable assignement i.e. %t', t => 'special = '.$body);
    my @res = $m->tmplini_special_body($body);
    $m->dpop($prog,@res);
};
sub tmplini_special_body {
    my ($m,$prog,$lihs,$text,%opts) = shift->opuc('tmplini_special_body',[qw(text)],@_);
    my ($verb, @args) = $m->text2list($text);
    my $fun = $m->tmplfil_special_get($verb,lihs => $lihs);
    my @res = &$fun($m, @args);
    $m->dpop($prog,@res);
};

=head4 Function tmplini_include

Include another file of the same kind.

We allow but do not encourage expansion of the filename, because that will mean that only the result of expansion based on values in the current DBM file will be traversed and all other files that could potentially be needed to generate object files will be disregarded.

To avoid this scenario, say

    ifeqs styl
    case jpat
    include jpat_lang.txt
    case dpat
    include dpat_lang.txt
    endif

rather than

     include ${styl}_lang.txt

Linke GNU Make, we also support

    -include

or

    sinclude

as a way of including without insisting on the presence of the to-be-included file.

=cut

sub tmplini_include {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('tmplini_include',@_);my %opts = $m->ref2hash($optsr);local $_= $s;
    my ($pfx,@matches) = m(\A([s\-])?include\s+(\S+)\s*\Z);
    return $m->dpop($prog) unless @matches;
    my $ok = 0;
    my $insistp = $pfx ? 0 : 1;
    my $fi = shift @matches;
    $fi = $m->grupfill($fi, lihs => $lihs);
    $opts{insistp} = $insistp;
    $ok = $m->riid_tmplvars_fayl($fi, %opts);
    $m->dpop1($prog,$ok);
};

=head4 Function tmplini_include_re

    include_re han.txt (\w+):\s(\w+)

like include, but additionally supply a regular expression by which the subfile is to be parsed, in simplified (pur) mode.
This regexp should match a key and a value.

return OK if 'include_re' statement was found and file was parsed.    

Like in tmplini_include, we also support the sinclude_re and -include_re versions of this directive.

=cut

sub tmplini_include_re {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('tmplini_include_re',@_);local $_ = $s;my %opts = $m->ref2hash($optsr);
    my @matches = m(\A([s\-])?include\_re\s+(\S+)\s*(.+)\Z);
    return $m->dpop($prog) unless @matches;
    my $ok = 0;
    my $tmp = shift @matches;
    my $insistp = $tmp ? 0 : 1;
    my $fi = shift @matches;
    $fi = $m->grupfill($fi, lihs => $lihs);
    my $re = shift @matches;
    $opts{insistp} = $insistp;
    $opts{setnomval} = $re;
    $opts{setnomval_pur} = 1;
    $ok = $m->riid_tmplvars_fayl($fi, %opts);
    $m->dpop1($prog,$ok);
};

=Function tmplini_var

check that we have an assignement statement like

	VAR ?:= VAL
	export var = val

and if so process it.

=cut

sub tmplini_var {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('tmplini_var',@_);local $_ = $s;
    my @nomval = m($m->{qre}->{setnomval});
    return $m->dpop($prog) unless @nomval;
    my $ok = $m->tmplini_setnomval($optsr,@nomval) ? 1 : 0;
    $m->dpop1($prog,$ok);
};

=head4 Function tmplini

Read one line of a Makefile.

arg1 is the line.
The remaining arguments are an key-value hash with the following

  qre.setnomval: regex for key-value assignment expressions, defaulting to config variable of same name
  setnomval_pur: treat setnomval as a pure assignement of value to key, without any further elements
  rank: '+', '-' or ''
    '+': important vocabulary document, even unexport'ed variables must be evaluated
    '-': unimportant vocabulary document, e.g. ancestral document's vocabulary, from which only exported variables are evaluated
    '': normal vocabulary document (e.g. template, prepended file) from which all variables that are not unexport'ed are evaluated

=cut

sub tmplini {
    my ($m,$prog,$lihs,$optsr,$s) = shift->tpuc('tmplini',@_);my %opts = $m->ref2hash($m->hashpush('ad',$optsr,$m->{progvars}->{tmplini_opts}));
    local $_ = $s;
    # Comment lines are suppressed, trainling spaces removed, but before a comment '#' sign only one space is removed.  This way we can define LF TAB SPC
    # They could be admitted in a linegroup by a special attribute __koment_ok, TBC cf phm_pub_sig150212
    return $m->dpop($prog) if m(\A\#) and !$lihs->{__koment_ok};
    $s = $m->rtrim_nokoment($_);
    # empty lines are suppressed but those containing blanks are not; in the future a linegroup could also admit empty lines by means of a special attribute __blankl_ok, TBD cf phm_pub_sig150212
    return $m->dpop($prog) if !length($_) and !$m->{lits}->{__blankl_ok};
    return $m->dpop1($prog,1) if $m->tmplini_kondsynt($lihs,$s); # process a conditional statement or { :IFOK return because excluded by a condition }
    do { $m->tmplini_pur($optsr,$_) || $m->tmplini_include_re($optsr,$s) || $m->ustop('unallowable syntax in restricted mode: %t', t => $_);$m->dpop1($prog,1);return 1 } if $opts{setnomval_pur};
# NON_FIN: { # still inside text element grup; CHANGE 190712: this stuff should be available in every context
#      last if $m->{lits}->{__fin};
    return $m->dpop1($prog,1) if $m->defnsynt($s); # memorizing define..endef statement
#    };
    $opts{rank} ||= '';
    $opts{rank_ignor} = $opts{rank} eq '-' ? 1 : 0; # ignore due to low rank of file
    return $m->dpop1($prog,1) if $m->grupsynt($optsr,$_,$s);
    return $m->dpop1($prog,1) if defined $m->tmplini_var($optsr,$s); # file:/phm/23/01/24/sig/_lng.phm_pub_sig230124.txt::dpop_undef_if_empty
    return $m->dpop1($prog,1) if defined $m->tmplini_special($s);
    return $m->dpop1($prog,1) if defined $m->tmplini_include($optsr,$s);
    return $m->dpop1($prog,1) if defined $m->tmplini_include_re($optsr,$s);
  EVAL: { # $(foreach ... $(eval $(call ...))) construction should return null string, see tmplini_syntdefn
      $m->{progvars}->{tmplini_opts} = $optsr; # used by tmplini_eval
      $_ = $m->grupfill($_, lihs => $lihs);
      $m->ustop(evalbad => t => $_) if m(\S);
    }
    $m->dpop($prog);
};

=head4 Function tmplini_eval

Ensure that a macro call such as

    $(foreach bin,${BINS},$(eval $(call ..)))

will work.

TODO

=head3 Function tmplvars_fayl

Synopsis:

    my ($fi, %atrs) = $m->tmplvars_fayl($fi_bas, %atrs);

Find the file that contains the template variables, return full path name and some attributes if found, nil otherwise.

We add more and pass the hash back; the C<dir> attribute is changed: it supplies the first path element to search in, and when we have found a file, the directory where we found it is returned as the new C<dir> attribute.

=cut

sub tmplvars_fayl {
    my ($m,$prog,$lihs,$fi_bas,%atrs) = shift->opuc('tmplvars_fayl',1,@_);
    return $m->dpop1($prog,$fi_bas) if $atrs{abs};
    do { $m->pwarn('having to set template include path in tmplvars_fayl');
	 $m->set_template_include_path } unless $m->{cache}->{tmplopts}->{INCLUDE_PATH};
  TMPLOPTS_NE_SERVICE: { # new weird case file:/phm/19/05/10/sig/_lng.phm_pub_sig190510.txt::tpaf  
      my $path = eval { $m->{template}->service->context->config->{INCLUDE_PATH} };
      last unless $path;
      unless ($m->{cache}->{tmplopts}->{INCLUDE_PATH}->[1] eq $path->[1]) { $m->pwarn('updating template include path in tmplvars_fayl cf tmplopts_ne_service from %o to %n', o => $m->{cache}->{tmplopts}->{INCLUDE_PATH}->[1], n => $path->[1]);$m->{cache}->{tmplopts}->{INCLUDE_PATH} = $path };
    }; 
    my ($dir, $tmp, $fi, $prop, $rest) = ('', '', '', '', '');
    local $_;
  DOKPROPS: {
      $_ = $fi_bas;
      ($tmp, $prop) = m(\A(.*)\?(.*)\Z);
      last  unless $tmp;
      $fi_bas = $tmp;
    RANK: {
	$_ = $prop;
	($tmp, $rest) = m(\A([\+\-])(.*)\Z);
	last unless $tmp;
	$atrs{rank} = $tmp;
	$prop = $rest;
      };
      $_ = $prop;
      do { my ($kii, $val) = split '=';next unless $kii;$atrs{$kii} = $val } for split ',';
    };
  ABS: {
      return $m->dpop($prog,$fi_bas,%atrs) if -e $fi_bas;
      last unless $fi_bas =~ m(\A\.*\/);
      $atrs{abs} = 1;
      $atrs{nekz} = 1;
      return $m->dpop($prog, $fi_bas, %atrs);
    };
    my @path = ();
    my $clean_path = sub {
	my @path0 = @{$m->{cache}->{tmplopts}->{INCLUDE_PATH}};
	my %pathp = ();
	my $dir = '';
	my $update_path = sub { 
	    my $insert = shift;
	    foreach $dir (@_) {
		next unless $dir;
		next unless -d $dir;
		next if $pathp{$dir};
		&$insert($dir);
		$pathp{$dir} = 1;
	    } };
	&$update_path(sub { push @path, @_ }, @path0, $atrs{dir});
	my @path1 = reverse @{$m->{konfig}->include_extra};
	&$update_path(sub { unshift @path, @_ }, @path1);
	my @path2 = reverse $lihs->getlst(include_extra => 0);
	&$update_path(sub { unshift @path, @_ }, @path2); 
    };
    &$clean_path;
    $atrs{path} = \@path;
    @{$m->{cache}->{tmplopts}->{INCLUDE_PATH}} = @path;
  DIR: {
      $dir = shift @path;
      next unless $dir;
      $tmp = catfile $dir, $fi_bas;
    FI_R: {
	last unless -e $tmp;
	$fi = $tmp;
	$atrs{dir} = $dir;
	last DIR;
      };
      redo DIR;
    };
  NOFB: {
      last if $fi;
      last unless $atrs{insistp};
      $m->ustop(nofbinpath => { b => $fi_bas, P => $m->koniug_et(@{$atrs{path}}) });
    };
    $fi = $m->absfayl($fi);
    $m->dpop($prog,$fi,%atrs);
};

=head3 Funtion lng_fayl_subfaylz;

Synopsis

    my @subfaylz = $m->lng_fayl_subfaylz($fi, \@faylz, %fi_atrs);

Return a list of text chunk files that a particular file adds to the Makefile target list, including, if valid, the file itself and any text chunk files invoked inside it by means of C<include> or C<include_re> statements.  Traverse the file and included subfiles recursively to obtain the complete list.  The included files appear before the including files.  Apart from that the order is the order of appearance of the include statements in the files.

Argument \@faylz lists already visited files that are no longer eligible for inclusion (and thus can not be on the list returned by this function).

Argument %fi_atrs is an attribute table as used by tmplvars_fayl, of which the $fi_atrs{dir} attribute is used to transport info about the current directory so that this can be prepended to the path and thus support relative directories in inclusion statements of text chunk files, allowing foreign directories to become temporary points of reference.

See also &A2E::MLDK::lng_faylz_src, the higher level function for which this one does most of the work.

=cut

sub lng_fayl_subfaylz {
    my ($m,$prog,$lihs,$fayl,%atrs) = shift->opuc('lng_fayl_subfaylz',1,@_);
    $m->pstop(funnovar => v => 'fayl') unless $fayl;
    $fayl = $m->absfayl($fayl);
    my $oldfaylp = $atrs{oldfaylp} || {};
    return $m->Wpop0($prog, p => fprereq => f => $fayl) if $oldfaylp->{$fayl};
    my @faylz = ($fayl);
    $oldfaylp->{$fayl} = 1;
    my $lini = 0;
    $m->open_fayl($fayl, $fayl, 'r');
  RIID: {
      $atrs{dir} = dirname $fayl;
      $atrs{dir} = $m->dir2dir if !$atrs{dir} or $atrs{dir} eq '.';
      while ($m->getlini($fayl)) {
	  $lini++;
	  next unless m(\A\s*\:?include\b);
	  chomp;
	  my $fib = '';
	FIB: {
	    ($fib) = m(\Ainclude\s+(\S+)\s*\Z);last if $fib;
	    ($fib) = m(\Ainclude\_re\s+(\S+)\s*\Z);last if $fib;
	    ($fib) = m(\Ainclude\s*\=\s*(\S+)\s*\Z);last if $fib;
	    ($fib) = m(\A\s*\:include\:(\S+)\:\s*\Z);last if $fib;
	  };
	  do { $m->uwarn(invexpfl => f => $fayl, l => $lini, e => $_);next } unless $fib;
	  $fib = $m->grupfill($fib, lihs => $lihs); # expand any variables that may be contained in the file name
	  my ($fi, %fi_atrs) = $m->tmplvars_fayl($fib, %atrs);
	  do { $m->uwarn(inkludfdko => f => $fib, D => $m->koniug_et(@{$fi_atrs{path}}));next } unless $fi;
	  my @subfaylz = eval { $m->lng_fayl_subfaylz($fi, %fi_atrs) };
	  $m->uwarn(inkludko => i => $fi, f => $fayl, l => $lini, m => $@) if $@;
	  push @faylz, @subfaylz;
      };
      $m->kloz_fayl($fayl);
    };
    $m->dpop($prog,@faylz);
};

=head3 Function riid_tmplvars_fayl

Example:
	$m->riid_tmplvars_fayl('lang.txt', tmplvars => $m->{lang_tmplvars}, insistp => 1);

Read template variables from Makefiles.  $arg1 is a file name, %arg2 is a set of attributes to that filename which may be specified via the commandline (e.g. throught the include_re statement) and augmented by parsing arg1 later.
Among these attributes, C<dir> is a local directory, e.g. that of the parent file from which the reading was initiated, that is temporarily prepended to the INCLUDE_PATH to allow us to find files by their relative pathname.

The following Makefile constructions are supported:

    KEY1 := VAL1
    KEY1 = VAL1
    KEY2 ?= VAL2
    KEY2 ?:= VAL2
    KEY3 := ${VAL1}${VAL2}
    KEY4 := $(shell get_val ${KEY3})
    include a2e/defs.mk

etc, see tmplini.  If $arg2{setnomval_pur} is set, only one construction is supported and it is treated as what in Makefile notation would be

    KEY1 := VAL1


=cut

our %litstag2pvar = (l => 'lang', t => 'tml');
our %lt2lt = (f => 't', tml => 't', lang => 'l'); # translate from convention of file:/adv/perl/A2E/MLHT.pm.tmpl::fi_opts_get_template_arbvars
sub dirtagarg2llitsdir {
    my ($m, $dir, $tag, $arg) = @_;
    catdir $dir, join '.', $tag, $arg;
}
    
sub set_litsdir { # set directory to read lits from
    my ($m,$prog,$lihs,$litstag0,$litstagarg) = shift->lpuc('set_litsdir',@_);$litstag0 ||= '';
    my $litstag = $lt2lt{$litstag0} || $litstag0 || 'l'; # 'l'
    my $pvar = $litstag2pvar{$litstag} || ''; # 'lang'
    $m->pstop('litsdir tag must be t or l, not %t', t => $litstag) unless $pvar;
    if ($litstagarg) { # 'de'
	$m->setpvar($pvar,$litstagarg, lihs => $lihs);
	# $lihs->litstag_undef_vars($litstag);
    } else {
	$litstagarg = ('l' eq $litstag) ? $m->pvar(lang => 1) : $m->pvar(tml => 1);
    };
    my $litsdir0 = $lihs->{vars}->{__litsdir__} or $m->pstop('base litsdir of lihs undefined');
    $m->pstop('base litsdir does not exist') unless -d $litsdir0;
    $lihs->{__nolitsdir__} = 0;
    $lihs->putstr(__nolitsdir__ => 0, typ => 'd');
    my $llitsdir = $m->dirtagarg2llitsdir($litsdir0, $litstag, $litstagarg);
    unless (-d $llitsdir) { mkdir $llitsdir or $m->pstop('failed to make directory %D', D => $llitsdir) };
    my $llitsnom = '__' . $litstag . 'litsdir__';
    my $llitsdir0 = $lihs->{vars}->{$llitsnom};
    if ($litstagarg and $llitsdir0 ne $llitsdir) {
	$lihs->{vars}->{$llitsnom} = $llitsdir;
	$lihs->litstag_undef_vars($litstag);
    };
    $m->setpvar('litstag',$litstag0,lihs => $lihs);
    my $litsdir = !$litstag0 ? $litsdir0 : $llitsdir;
    $m->setpvar('litsdir',$litsdir,lihs => $lihs);
    $m->dpop1($prog,$litsdir);
};

sub litstag_opts_setvars {
    my ($m,$prog,$lihs,%opts) = shift->opuc('litstag_opts_setvars',0,@_);
    my $litstag = $opts{litstag};
    my $litsdir = $lihs->{vars}->{__nolitsdir__} ? '' : $m->set_litsdir($lihs,$litstag,$opts{litstagarg});
    my $ripetp = $opts{ripetp} || 0;
    # my $flng = $opts{flng} || 0; # if this is true, write even structure info to llitsdir .lits/l.zh or .lits/t.html, assuming that .zh.txt has its own grup structures
    $lihs->{vars}->{__ripetp__} = $ripetp;
    $m->dpop1($prog,$litsdir);
};

sub fib2flng {
    my ($m,$fib) = @_;
    my ($flng) = $fib =~ m(\b(?:\_lng.\w+|lang)\.(\w{2})\.txt\Z);
    $flng;
};    
sub riid_tmplvars_fayl {
    my ($m,$prog,$lihs,$fib,%opts) = shift->opuc('riid_tmplvars_fayl',1,@_);
    $m->pstop('file to look for is not a string but a %r', r => ref($fib)) if ref $fib;
    $fib = $m->grupfill($fib, lihs => $lihs);
    $m->{__flvl} = 0; # riid_fib: keep track of __flvl i e text level within the file
    # if ($m->{legit}->{$fib}) { $m->uwarn('refusing to read file %f a second time', f => $fib);return } else { $m->{legit}->{$fib} = 1 };
    my $flng = $m->fib2flng($fib);
    $opts{flng} ||= $flng if $flng;
    $m->pstop('grupfill-ed file to look for %f is not a string', f => $fib) if ref $fib;
    (my $fi, %opts) = $m->tmplvars_fayl($fib, %opts);
    $m->litstag_opts_setvars(%opts);
    $m->decho('reading without a litsdir to write to') if $lihs->{vars}->{__nolitsdir__} or !$lihs->{vars}->{__litsdir__};
    unless ($fi) {
	$m->ustop_or_warn(!$opts{insistp}, 'found no file named %f in include path %P', f => $fib, P => $m->{cache}->{tmplopts}->{INCLUDE_PATH});
	return $m->dpop1($prog,1);
    };
  RE_FI: {
      last unless $m->fh($fi);
      $m->uwarn('attempted to read already open file %f once more', f => $fi);
      return $m->dpop($prog);
    };
    my $verbose = $m->pvar('verbose');
    printf STDERR "\n".'[ reading %s', $fi.($opts{rank}||' ') if $verbose;
    $m->open_fayl($fi, $fi, 'r');
    my $get_linivar = sub {
	$lihs->{vars}->{__fayl} = $fi; #special variable __fayl: current file, set each time
	$opts{dir} = dirname $fi;
	local $_ = $fi;
	s(\W)(_)g;
	return '__lini'.$_.'__';
    };
    my $linivar = &$get_linivar;
    $lihs->{vars}->{$linivar} = 0;
    local $_;
    while ($m->getlini($fi)) {
	$lihs->{vars}->{$linivar}++;
	chomp;
	$m->decho(exofls => l => $lihs->{vars}->{$linivar}, f => $fi, s => $_ );
	eval { $m->tmplini(\%opts,$_) };
	next if ! $@;
	$m->ustop(errflm => f => $fi, l => $lihs->{vars}->{$linivar}, m => $@); 
    };
    undef $lihs->{vars}->{$linivar};
    my $msg = 'OK ]'."\n";
    print STDERR $msg if $verbose;
    $m->kloz_fayl($fi);
    delete $lihs->{vars}->{__fayl};
    $m->ustop(fgeof => f => $fi, g => $m->{lits}->{__nom}) if $m->{__flvl}; # djis 201225 $m->{lits}->{__nom} and not $opts{sup};
    $m->{lits} = { __lvl => 0 };
    $m->dpop1($prog,1);
};

sub riid_tmplvars_fayl1 {
    my ($m,$prog,$lihs,$fayl,%opts) = shift->opuc('riid_tmplvars_fayl1',1,@_);
    $m->riid_tmplvars_fayl($fayl,%opts);
    foreach my $litnom (@{$m->{debug_litnoms}}) {
	$m->pwarn('after reading file %f variable %n has value %v', f => $fayl, n => $litnom, v => $lihs->{vars}->{$litnom});
    };
    $m->dpop1($prog,1);
}

=head3 Function riid_tmplvars_faylz

Read all series of maketext files based on some given options

    args := initvars, optsref, fayl+
    rets := ok

Invoked via A2E::MLDK or A2E::MLMK:

    $m->riid_tmplvars_faylz({ dok => $dok, langs => $langs_str, lang0 => $lang0 }, { msglini => 1 }, @fayls);

=cut

sub riid_tmplvars_faylz {
    my ($m,$prog,$initvars,$optsr,@faylz) = shift->ppuc('riid_tmplvars_faylz',@_);my %opts = $m->ref2hash($optsr);
    $m->riid_tmplvars_init($initvars, %opts);
    foreach my $fayl (@faylz) { $m->riid_tmplvars_fayl1($fayl, %opts) };
    $m->riid_tmplvars_post;
    $m->dpop1($prog,1);
};

=head2 Top level functions

=head3 Function tmplfil1

Process one template.

=cut

sub tmplfil1 {
    my ($m,$prog,$fi,%opts) = shift->ppuc('tmplfil1',@_);
    my $tmplvars = $opts{tmplvars} || $m->{lihs}->{vars};
    my $template = $opts{template} || $m->{template};
    $template->process($fi, $tmplvars);
    $m->pstop($m->{template}->error()) if $@;
    $m->sav2out;
    $m->dpop1($prog,1);
};

=head3 Function tmplfil

Process all templates supplied through the infaylz option and the [commandline] arguments.

=cut

sub tmplfil {
    my ($m,$prog,@faylz) = shift->ppuc('tmplfil',@_);
    $m->{konfig}->infaylz($_) for @faylz;
    $m->set_template;
    $m->tmplfil1($_) for @{$m->{konfig}->infaylz};
    $m->dpop1($prog,1);
};

1;

=head2 Changelog
=over
=item file:/phm/23/01/31/sig/_lng.phm_pub_sig230131.txt::kalkop
=back

# Local Variables:
# coding: utf-8
# mode: perl
# srcfile: "/adv/perl/A2E/Tmplfil.pm.tmpl"
# End:
