:
#!/usr/bin/perl -w
# ||<-snip->|| start
# @hs@snippets - snippets administration tool@he@
#
# usage: snippets [OPTIONS] [COMMAND]@rb@
#        snh => snippets --help
#        snl => snippets --list          [name-rx]
#        sni => snippets --as-includes
#                        --list          [name-rx]
#        sng =>          --grep          [grep-opts]
#
#        snc => snippets --cat           [name-rx] | - [temp-snippet]
#        snr => snippets --replace --process
#                         --cat          [name-rx]
#        snn => snippets --new           [filename [name]]
#
#        sns => snippets --store         [name] [text|file|url]
#        sna => snippets --append        [name] [text|file|url]
#
#        snw => snippets --work          [work(1) args]
# @contents@
# @s@COMMON OPTIONS FOR ALL COMMANDS@eb@
#   --debug                      show debug messages
#   -q, --quiet                  suppress status messages.
#   -d, --dir         directory  set SNIPS_DIR to DIRETORY and prepend
#                                it to SNIPS_PATH.
#   --accept-cat      ACCEPT-RX  accept categories matching RX.
#   -i, --ignore-cat  IGNORE-RX  ignore categories matching RX.
#   -m, --mode        MODE       setup parameters according to MODE.
#   -t, --title       [TITLE]    set @|title@ to `title`.
#   -u, --uuid        [UUID]     set @|uuid@ to `uuid`.
#   --main-only                  only use main mode category.

# @s@COMMAND LIST@eb@
#     -l, --list  [name-rx]@n@
#   list snippets matching NAME-RX@n@
#   OPTIONS@rb@
#     --as-includes               list as snippets includes
#     --fn-sep        [SEP]       file name separator (default '#').
#
# @s@COMMAND GREP@eb@
#     -g, --grep  [grep-opts]@n@
#   grep snippets with GREP-OPTS@n@
#   OPTIONS@rb@
#     --as-includes               list as snippets includes

# @s@COMMAND CAT@eb@
#     -c, --cat   [name-rx] | - [temp-snippet]@n@
#   retrieve snippet matching NAME-RX or process temporary snippet
#   from command-line or standard input.@n@
#   OPTIONS@rb@
#         --all                    retrieve all snippets, not just the first match.
#     -r, --replace                do standard replacements @|date@ ...
#         --no-replace             do no standard replacements @|date@ ... (default)
#     -p, --process                process commands
#         --no-process             do not process commands (default)
#
# @s@COMMAND NEW@eb@
#     -n, --new   [filename [name]]@n@
#   Retrieve snippet based on filename.
#   Implies --replace and --process.@n@
#   The filename extension determines the mode and the name.
#   the default name is <mode-category>_<new>.@n@
#   OPTIONS@rb@
#     -f, --force                  overwrite existing output file.
#     -r, --replace                do standard replacements @|date@ ... (default)
#         --no-replace             do no standard replacements @|date@ ...
#     -p, --process                process commands (default)
#         --no-process             do not process commands
#
# @s@COMMON OPTIONS FOR CAT/NEW@eb@
#         --no-skip                do not skip any sections, if not processing.
#         --no-indent              do not add indent to lines. (Useful for --mark).
#         --no-final               without final replacement (for further processing as snippet)
#         --mark[=NUM]             mark snippet and included snippets.
#                                  (see section MARK FLAGS)
#     -k, --key         [KEY]      add/clear a replacement key. (deprecated) (implies --replace)
#     -v, --value       [VALUE]    set replacement value for last added key.
#         --verbose                show full snippets.

# @s@COMMAND STORE@eb@
#     -s, --store [name] [text|file|url]@n@
#   store text/file/url as snippet.@n@
#   OPTIONS@rb@
#     -f, --force                  overwrite existing snippet for --store.
#
# @s@COMMAND APPEND@eb@
#     -a, --append [name] [text|file|url]@n@
#   append or store text/file/url as snippet.
#
# @s@COMMON OPTIONS FOR STORE/APPEND@eb@
#   --literal                      do not quote snippet tags
#   --use-both                     use both header and footer from snippet text
#   --use-header                   use header from snippet text
#   --use-footer                   use footer from snippet text

# @s@COMMAND WORK@eb@
#     -w, --work  [work(1) arguments]@n@
#   change  working  directory  to  $SNIPS_DIR and  run  work(1)  with
#   arguments.

# @s@COMMAND INSTALL@eb@
#   --install   [bin_dir]        # default: /usr/local/bin
#
# @s@COMMAND DIST@eb@
#   --dist      [dist_dir]       # default: /srv/ftp/pub

# @s@MARK FLAGS@eb@
#   0 000 => no marking, unless processing
#   1 001 => mark tagged, if processing
#   2 010 => mark untagged, if processing
#   3 011 => mark both, if processing
#   4 100 => forced marking
#   5 101 => always mark tagged
#   6 110 => always mark untagged
#   7 111 => always mark both

# @s@SNIPPET FILE NAMES@e@
#   The  snippet category is  determined as  the substring  before the
#   first underscore.
#
#   If no mode is specified for a snippet, the prefix category is used
#   as such.
#
#   If a supplied  snippet name for storage does  not have a category,
#   the current mode is automatically prepended.
#
#   In order to allow for  an optional sub-category / name scheme, the
#   first dot  is used separate  categories and name. This  allows for
#   underscores  to appear  in  a  name part  after  the dot,  without
#   implying a category::
#
#       <category> `_` [ <sub-category> `.` ] <name>
#
#   The sub-category is  just a suggestion and has  no special meaning
#   for snippets(1).
#
#   The dot-separator is only used  to determine the end of substring,
#   where snippets(1) looks for an underscore. It is entirely optional
#   and has no other special meaning.

# @s@|@fempty@|<-snap->|| HANDLERS@eb@
#   - capture  on | off | clear | get | drop
#     drop == clear + off
#
#   - debug    NUM
#     set debug level to NUM
#
#   - show     [ [[[!]final] replacement] ... ]
#     show current value of replacement
#
#   - alias    alias_name command_handler
#     define alias_name to behave as command_handler.@rb@

#   - start    comment
#     start snippet
#
#   - stop     comment
#     stop snippet
#
#   - title    title
#     Not processed
#
#   - uuid     uuid
#     Not processed@rb@

#   - mark     [text]
#     without `text`, a timestamp is used for the mark
#
#   - beg
#     see option --mark
#
#   - end
#     see option --mark@rb@

#   - indent   [+-]NUM
#     set indent to NUM. If `+` or `-` is given, increase or decrease indent respectively.
#     Option --no-indent suppresses indents.@rb@

#   - rem      [text]
#     text is ignored, the tag is removed
#
#   - trim     left|right|all
#     accumulated text is trimmed. `all` is the default.
#
#   - drop
#     accumulated text is dropped.
#
#   - quote    text
#     `text` is inserted verbatim without replacement or processing
#
#   - todo     comment
#     add TODO entry@rb@

#   - undef    key
#     undefine @|key@
#
#   - define   key [['!']'default'] [['!']'final']
#                  [['!']'unquote'] [['!']'replace'] [['!']'process']
#     start/stop defining replacement for @|key@.
#
#     - If `default` is specified, only set replacement, if it not yet
#       defined.
#     - If  `final`   is  specified,  set  a   replacement  for  final
#       replacement pass.
#     - If `unquote`  is specified, remove  one level of  quoting from
#       replacements.  before replacing.
#     - If  `replace` is  specified,  substitute current  replacements
#       before definition.
#     - If `process`  is specified, the collected  replacement text is
#       processed (default is the global processing status).
#
#   - default  key value
#     If replacing  is enabled, set @|key@ replacement  to `value`, if
#     it  is not yet  defined. One  level of  quoting is  removed from
#     `value`.
#
#   - subst    key value
#     If replacing is enabled,  set @|key@ replacement to `value`. One
#     level of quoting is removed from `value`.
#
#   - final    key value
#     If replacing  is enabled, set @|key@ replacement  to `value` for
#     final replacement after comment cleanup. One level of quoting is
#     removed from `value`.@rb@

#   - verbatim
#     begin/end verbatim block
#
#   - snip
#     begin/end block
#
#   - snap
#     begin/end block
#
#   - read
#
#   - include  file-rx [accept cat-accept-rx] [ignore cat-ignore-rx] \
#                      [[!]process] [[!]skip] \
#                      [[!]replace] [[!]export] [[!]import] \
#                      [key=value ...] [-key]
#
#     include file matching FILE-RX.
#
#     See  section 'INCLUDE  FILE RX  REPLACEMENTS' below  for FILE-RX
#     quoting.
#
#     - if   PROCESS    is   given,   turn    processing   on/off   as
#       specified. default: global processing flag.
#     - if  SKIP  is  given,  set  skipping,  if  not  processing,  to
#       always/never as specified. default: global no_skip flag.
#     - if    REPLACE   is   given,    turn   replacing    on/off   as
#       specified. default: global replace flag.
#     - if  IMPORT  is  given,  keep/restore replacements  defined  in
#       include file as specified.  default: on.
#     - ACCEPT. default: global --accept-cat option. !ACCEPT == IGNORE
#     - INGORE. default: global --ignore-cat option. !IGNORE == ACCEPT@rb@

#   - exec     [[!]dump] [[!]process] [[!]skip] [[!]autostart] \
#              [[!]replace] [[!]export] [[!]import] \
#              [sprocess] [sreplace] [sunquote] \
#              [key=value ...] [-key]
#     sh(1)-cmd
#     ...
#     exec
#
#     get text  from output of  sh(1)-cmd. The result is  processed as
#     snippets text.
#
#     - if DUMP is given, the shell command output is not processed in
#       any way. This avoids end-of-line trimming, which would messs
#       up binary data.
#
#     - if SUNQUOTE is given, the shell script is unquoted after
#       processing and replacing, but before execution.
#
#   - shellq   sh(1)-cmd
#     get text  from output  of sh(1)-cmd. The  result is  not further
#     processed.
#
#   - shell    sh(1)-cmd
#     get text  from output of  sh(1)-cmd. The result is  processed as
#     snippet.@rb@

#   - skip     [`keep`]
#     start/stop  skipping. If  keep is  specified, only  drop section
#     when processing@rb@

#   - if       [[!]final] [!]defined key
#     include section up to next `elif/else/fi`, only if condition is true.
#
#   - if       [[!]final] [!]eq key value
#     include section up to next `elif/else/fi`, only if condition is true.
#
#   - elif     [[!]final] { [!]defined key | [!]eq key value }
#     include section up to next `elif/else/fi`, only if no if/elif
#     was included before and if condition is true.
#
#   - else
#     include section up to next `fi`, if no if/elif was included before.
#
#   - fi
#     terminate if/elif/else/fi block.

# @s@SPECIAL SKIP HANDLERS@e@

# If a snippet is retrieved for snippets internal use::
#
#     for_snips        => [quote]
#     not_for_snips    => [skip]

# If a snippet is retrieved for external use::
#
#     for_snips        => [skip]
#     not_for_snips    => [quote]

# @s@DEPRECATED HANDLERS@eb@
#   - evalq   text
#     deprecated for portability.
#     perl(1) eval of `text`. The result is not further processed.
#
#   - eval    text
#     deprecated for portability.
#     perl(1)  eval of  `text`. The  result is  processed  as snippets
#     text.

# @s@SNIPPET TAG QUOTING@e@
#   Snippet  tags are  only recognized  at  the beginning  of a  line,
#   optionally proceeded  by a comment start  skip. Therefore, snippet
#   tags within  a line do not  need to be quoted.  Other snippet tags
#   can be quoted through the final replacement mechanism. E.g.::
#
#     ;; |@|fempty@|<-snap->||
#
#   results in::
#
#     ;; ||<-snap->||
#
#   and still allows symbol  tag navigation with the reduced delimiter
#   set `("|<-" . "->|")`.

# @s@REPLACEMENT QUOTING@eb@
#   The first `|` after an `@` is removed in the final pass:
#
#     @||quoted@   => @|quoted@
#     @|||quoted@  => @||quoted@
#     @||||quoted@ => @|||quoted@
#
#   This also allows for quoting of the generic comment syntax::
#
#     @||:comm@    => @|:comm@

# @s@STANDARD REPLACEMENTS@eb@
#   @|mode@             => [text]

#   @|empty@            => []
#   @|space@            => [ ]
#   @|nl@               => <NEWLINE>

#   @|filename@         => if output filename is applicable
#   @|filebase@         => if output filename is applicable

#   @|dts@              => [2011-11-29 22:57:08]
#   @|sts@              => [1322603828]

#   @|date@             => [2011-11-29]
#   @|time@             => [22:57:08]

#   @|year@             => [2011]
#   @|month@            => [11]
#   @|day@              => [29]
#   @|hours@            => [22]
#   @|minutes@          => [57]
#   @|seconds@          => [08]

#   @|:_comm@           => sep + comment-end
#   @|:comm@            => comment-start
#   @|:comm_@           => comment-start + sep
#   @|:comm_line@       => [@|:comm@@|_comm@]
#   @|:comme@           => comment-end

#   @|:bcomm@           => block-comment-start
#   @|:bcomme@          => block-comment-end
#   @|:bcomm_@          => block-comment-start + sep
#   @|:_bcomm@          => sep + block-comment-end

#   @|:lcomm@           => line comment within block-comment
#   @|:lcomm_@          => line comment within block-comment + sep

# @s@FINAL REPLACEMENTS@eb@
#   @|fempty@           => []
#   @|fspace@           => [ ]
#   @|fnl@              => <NEWLINE>

# @s@SPECIAL REPLACEMENTS@eb@
#   @|snip_mode@        => the current snippet mode, which is not necessarily the same as the emacs mode.
#   @|snip_self@        => the current snippet file
#   @|snip_selfi@       => the current snippet file, quoted for `include` command.
#   @|snip_selfq@       => the current snippet file, quoted for shell
#   @|snip_self_dir@    => the current snippet file
#   @|snip_self_diri@   => the current snippet file, quoted for `include` command.
#   @|snip_self_dirq@   => the current snippet file, quoted for shell
#   @|snip_self_base@   => the current snippet file
#   @|snip_self_basei@  => the current snippet file, quoted for `include` command.
#   @|snip_self_baseq@  => the current snippet file, quoted for shell

# @s@COMMAND LINE SUBSTITUTION HANDLING@e@
#   1. `snips_process_line__` replaces entire command line::@n@
#        |@fempty@|<-snap->|| @|command@ opt=@||val@ opt2=@|||val2@
#        =>
#        |@fempty@|<-snap->|| replaced opt=@||val@ opt2=@|||val2@
#
#   2. `subst` command removes one level of quoting::@n@
#        |@fempty@|<-snap->|| replaced opt=@||val@ opt2=@|||val2@
#        =>
#        |@fempty@|<-snap->|| replaced opt=@|val@ opt2=@||val2@
#
#   3. `subst` command splits option arguments into key/value pairs::@n@
#        |@fempty@|<-snap->|| replaced opt=@|val@ opt2=@||val2@
#        =>
#        [[ opt, @|val@ ], [ opt2, @||val2@ ]]
#
#   4. `subst` command replaces values::@n@
#        [[ opt, @|val@ ] [ opt2, @||val2@ ]]
#        =>
#        [[ opt, replaced ], [ opt2, @||val2@ ]]
#
#   5. `subst` command removes another level of quotes::@n@
#        [[ opt, replaced ], [ opt2, @||val2@ ]]
#        =>
#        [[ opt, replaced ], [ opt2, @|val2@ ]]

# @s@INCLUDE FILE RX REPLACEMENTS@e@
#   The  first  level  of  quotes   is  removed  on  FILE-RX  and  the
#   appropriate replacements  are filled  in.  Then, another  level of
#   quotes is removed. This works exactly like the `subst` command.
#
#   If you  wish to match a  filename with a valid  replacement in it,
#   you must  double-quote it (e.g.  `@|||space@`), or  use other means
#   like @\|match@ or `@[m]atch@`.
#
#   The following replacements are  defined as defaults (i.e., if they
#   are not  yet defined) when replacing  the first quote  level of an
#   `include` file regexp::
#
#     @|snip_fn_space@  => ` `
#     @|snip_fn_tab@    => `\t`
#     @|snip_fn_cr@     => `\r`
#     @|snip_fn_nl@     => `\n`

# @s@CONFIGURATION@e@
#   SNIPS_PATH is taken from the environment variable `SNIPS_PATH`. If
#   the variable is not set, `${HOME}/snippets` is used.
#
#   SNIPS_DIR   is   then   taken   from  the   environment   variable
#   `SNIPS_DIR`.  If the  variable is  not set,  the first  element of
#   SNIPS_PATH is used.
#
#   All  directories  named  `.snippets`  going up  from  the  current
#   directory to the root level are prepended to SNIPS_PATH in reverse
#   order.  I.e., the  `.snippets`  directory in  the current  working
#   directory takes highest precedence.
#
#   SNIPS_PATH  is  searched for  `snip_setup`.   The first  occurence
#   found is processed. Any resulting text is discarded.
#
#   SNIPS_PATH is then  searched in reverse order for  all files named
#   `.snips.rc`,  which  are  all  processed. Any  resulting  text  is
#   discarded.
#
#   It  is really  intended  to process  `snip_setup` and  `.snips.rc`
#   before option processing. However, this still remains ``|:todo:|``.
#
#   The   configuration  processing   is  mainly   useful   to  define
#   replacements. But  can also be  used with the `exec`  mechanism to
#   create directories, files and the like.

# @s@ENVIRONMENT@eb@
#   SNIPS_PATH is searched for snippets
#      SNIPS_PATH="${SNIPS_PATH-${HOME}/snippets}"
#
#   SNIPS_DIR is used to store snippets
#     SNIPS_DIR="${SNIPS_DIR-first element of SNIPS_PATH}"
#
#   SNIPS_MODE is the default mode to be used.
#
#   SNIPS_CAT is the default category (rx) to be used.
#
#   SNIPS_COMMENT_START
#
#   SNIPS_COMMENT_START_SKIP
#
#   SNIPS_COMMENT_END
#
#   SNIPS_COMMENT_END_SKIP
#
#   SNIPS_COMMENT_START_SEP
#
#   SNIPS_COMMENT_END_SEP
#
# ||<-snap->|| if !defined min_mode
# Copyright  (C) 2010,  2011, 2012  Wolfgang Scherer,  Sudetenstr. 48,
# D-97340 Marktbreit, <Wolfgang.Scherer@gmx.de>
# ||<-snap->|| fi
# ||<-snap->|| skip
eval 'exec perl -w -S $0 ${1+"$@"}'
if 0;
#
# This file is part of Snippets.
#
# Snippets is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# Snippets is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with Snippets; see the file COPYING.  If not,
# write to Wolfgang Scherer, Sudetenstr. 48, D-97340
# Marktbreit, or the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307, USA.
# ||<-snap->|| skip
# ||<-snip->|| stop

# Handle -?, -h, --help
sub usage {
    local ( *HANDLE ) = shift;
    my $rst_format = shift || 0;
    my $min_format = shift || 0;
    my $opts = shift || '';
    my $programq = sqe($0);
    $programq = snip_quote_file($0);

    my $define = 'undef';
    if ($rst_format) {
        $define = 'subst';
    }

    my $mindef = 'undef';
    if ($min_format) {
        $mindef = 'subst';
    }

    my $script = "
|"."|<-snip->|| start
||<-snap->|| define n
\@nl@#
||<-snap->|| define
||<-snap->|| ${define} rst_mode
||<-snap->|| ${mindef} min_mode
||<-snip->|| if !defined rst_mode
||<-snap->|| define rb

\@empty@
||<-snap->|| define
||<-snap->|| define s
||<-snap->|| define
||<-snap->|| define e
\@rb@
||<-snap->|| define
||<-snap->|| define eb
\@rb@
||<-snap->|| define
||<-snap->|| define hs
||<-snap->|| define
||<-snap->|| define he
||<-snap->|| define
||<-snap->|| subst contents
||<-snap->|| fi
||<-snip->|| if defined rst_mode
||<-snap->|| define rb

#
# ::
#
\@empty\@
||<-snap->|| define
||<-snap->|| define s
--------------------------------------------------
# \@empty@
||<-snap->|| define
||<-snap->|| define e

# --------------------------------------------------
||<-snap->|| define
||<-snap->|| define eb
\@e@\@rb@
||<-snap->|| define
||<-snap->|| define contents

# .. contents::
#
||<-snap->|| define
||<-snap->|| define hs
==================================================
# \@empty@
||<-snap->|| define
||<-snap->|| define he

# ==================================================
||<-snap->|| define
||<-snip->|| drop
||<-snap->|| fi
||<-snap->|| if defined min_mode
||<-snap->|| subst contents
||<-snap->|| fi
||<-snap->|| include $programq
|"."|<-snip->|| stop
";

    my $cmd = "printf '%s\\n' ".sqe($script)." | $0 --process --replace --mode pl ".$opts." --cat - |";
    open ( SELF, $cmd );
    while ( <SELF> ) {
        if ( m/^#!|^:/so ) {
            next;
        }
        if ( ! m/^#|^[ \t]*$/so ) {
            last;
        }
        s,^# ?,,so;
        printf HANDLE ( "%s", $_ );
    }
}

use vars qw( $prog_name $bin_dir $inst_dir );
use vars qw($msg_output);

BEGIN {
    $msg_output = *STDERR;
    $bin_dir = '.';
    $0 =~ m,^(.*)/(.*)$,so;
    $bin_dir = $1 if $1;
    $prog_name = 'snippets';
    $prog_name = $2 if $2;
    unshift ( @INC, $bin_dir );
    $inst_dir = $bin_dir;
    my $l = readlink ( $0 );
    if ( $l ) {
        if ( $l !~ m,/,so) {
            #           $prog_name = $l;
        } elsif ( $l =~ m,^(.*)/(.*)$,so && $1 ) {
            $inst_dir = $1;
            $prog_name = $2;
            $l =~ m,^(/),so;
            $inst_dir = $bin_dir.'/'.$inst_dir if !$1;
            unshift ( @INC, $inst_dir );
        }
    }
}

# make UUID::Tiny compatible with `use strict`
use vars qw(
  *UUID::Tiny::equal_UUIDs
  *UUID::Tiny::clk_seq_of_UUID
  *UUID::Tiny::clk_seq_of_UUID
  *UUID::Tiny::create_UUID_as_string
  *UUID::Tiny::create_UUID
  *UUID::Tiny::string_to_UUID
  *UUID::Tiny::version_of_UUID
  *UUID::Tiny::time_of_UUID
  *UUID::Tiny::UUID_to_string
  *UUID::Tiny::is_UUID_string
  );

# THE FOLLOWING MODULE IS COPIED FROM ITS ORIGINAL SOURCE AS IS AND
# THEREFORE IS NOT COVERED BY THE COPYRIGHT NOTICE AT THE BEGINNING OF
# THE FILE.
# vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
package UUID::Tiny;

use 5.008;
use warnings;
use strict;
use Carp;
use Digest::MD5;
use MIME::Base64;
use Time::HiRes;
use POSIX;

our $SHA1_CALCULATOR = undef;

{
    # Check for availability of SHA-1 ...
    local $@; # don't leak an error condition
    eval { require Digest::SHA;  $SHA1_CALCULATOR = Digest::SHA->new(1) } ||
    eval { require Digest::SHA1; $SHA1_CALCULATOR = Digest::SHA1->new() } ||
    eval {
        require Digest::SHA::PurePerl;
        $SHA1_CALCULATOR = Digest::SHA::PurePerl->new(1)
    };
};

our $MD5_CALCULATOR = Digest::MD5->new();

# ToDo:
# - Check and report for undefined UUIDs with all UUID manipulating functions!
# - Better error propagation for better debugging.

=head1 NAME

UUID::Tiny - Pure Perl UUID Support With Functional Interface

=head1 VERSION

Version 1.03

=cut

our $VERSION = '1.03';

=head1 SYNOPSIS

Create version 1, 3, 4 and 5 UUIDs:

    use UUID::Tiny;

    my $v1_mc_UUID         = create_UUID();
    my $v3_md5_UUID        = create_UUID(UUID_V3, $str);
    my $v3_md5_UUID        = create_UUID(UUID_V3, UUID_NS_DNS, 'caugustin.de');
    my $v4_rand_UUID       = create_UUID(UUID_V4);
    my $v5_sha1_UUID       = create_UUID(UUID_V5, $str);
    my $v5_with_NS_UUID    = create_UUID(UUID_V5, UUID_NS_DNS, 'caugustin.de');

    my $v1_mc_UUID_string  = create_UUID_as_string(UUID_V1);
    my $v3_md5_UUID_string = UUID_to_string($v3_md5_UUID);

    if ( version_of_UUID($v1_mc_UUID) == 1   ) { ... };
    if ( version_of_UUID($v5_sha1_UUID) == 5 ) { ... };
    if ( is_UUID_string($v1_mc_UUID_string)  ) { ... };
    if ( equal_UUIDs($uuid1, $uuid2)         ) { ... };

    my $uuid_time    = time_of_UUID($v1_mc_UUID);
    my $uuid_clk_seq = clk_seq_of_UUID($v1_mc_UUID);

=cut

=head1 DESCRIPTION

UUID::Tiny is a lightweight, low dependency Pure Perl module for UUID
creation and testing. This module provides the creation of version 1 time
based UUIDs (using random multicast MAC addresses), version 3 MD5 based UUIDs,
version 4 random UUIDs, and version 5 SHA-1 based UUIDs.

ATTENTION! UUID::Tiny uses Perl's C<rand()> to create the basic random
numbers, so the created v4 UUIDs are B<not> cryptographically strong!

No fancy OO interface, no plethora of different UUID representation formats
and transformations - just string and binary. Conversion, test and time
functions equally accept UUIDs and UUID strings, so don't bother to convert
UUIDs for them!

All constants and public functions are exported by default, because if you
didn't need/want them, you wouldn't use this module ...

UUID::Tiny deliberately uses a minimal functional interface for UUID creation
(and conversion/testing), because in this case OO looks like overkill to me
and makes the creation and use of UUIDs unnecessarily complicated.

If you need raw performance for UUID creation, or the real MAC address in
version 1 UUIDs, or an OO interface, and if you can afford module compilation
and installation on the target system, then better look at other CPAN UUID
modules like L<Data::UUID>.

This module is "fork safe", especially for random UUIDs (it works around
Perl's rand() problem when forking processes).

This module should be "thread safe," because its global variables
are locked in the functions that access them. (Not tested - if you can provide
some tests, please tell me!)

=cut

=head1 DEPENDENCIES

This module should run from Perl 5.8 up and uses mostly standard (5.8 core)
modules for its job. No compilation or installation required. These are the
modules UUID::Tiny depends on:

    Carp
    Digest::MD5   Perl 5.8 core
    Digest::SHA   Perl 5.10 core (or Digest::SHA1, or Digest::SHA::PurePerl)
    MIME::Base64  Perl 5.8 core
    Time::HiRes   Perl 5.8 core
    POSIX         Perl 5.8 core

If you are using this module on a Perl prior to 5.10 and you don't have
Digest::SHA1 installed, you can use Digest::SHA::PurePerl instead.

=cut

=head1 ATTENTION! NEW STANDARD INTERFACE (IN PREPARATION FOR V2.00)

After some debate I'm convinced that it is more Perlish (and far easier to
write) to use all-lowercase function names - without exceptions. And that it
is more polite to export symbols only on demand.

While the 1.0x versions will continue to export the old, "legacy" interface on
default, the future standard interface is available using the C<:std> tag on
import from version 1.02 on:

    use UUID::Tiny ':std';
    my $md5_uuid = create_uuid(UUID_MD5, $str);

In preparation for the upcoming version 2.00 of UUID::Tiny you should use the
C<:legacy> tag if you want to stay with the version 1.0x interface:

    use UUID::Tiny ':legacy';
    my $md5_uuid = create_UUID(UUID_V3, $str);

=cut

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT;
our @EXPORT_OK;
our %EXPORT_TAGS = (
     std =>         [qw(
                        UUID_NIL
                        UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500
                        UUID_V1 UUID_TIME
                        UUID_V3 UUID_MD5
                        UUID_V4 UUID_RANDOM
                        UUID_V5 UUID_SHA1
                        UUID_SHA1_AVAIL
                        create_uuid create_uuid_as_string
                        is_uuid_string
                        uuid_to_string string_to_uuid
                        version_of_uuid time_of_uuid clk_seq_of_uuid
                        equal_uuids
                    )],
    legacy =>       [qw(
                        UUID_NIL
                        UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500
                        UUID_V1
                        UUID_V3
                        UUID_V4
                        UUID_V5
                        UUID_SHA1_AVAIL
                        create_UUID create_UUID_as_string
                        is_UUID_string
                        UUID_to_string string_to_UUID
                        version_of_UUID time_of_UUID clk_seq_of_UUID
                        equal_UUIDs
                    )],
);

Exporter::export_tags('legacy');
Exporter::export_ok_tags('std');

=head1 CONSTANTS

=cut

=over 4

=item B<NIL UUID>

This module provides the NIL UUID (shown with its string representation):

    UUID_NIL: '00000000-0000-0000-0000-000000000000'

=cut

use constant UUID_NIL => "\x00" x 16;

=item B<Pre-defined Namespace UUIDs>

This module provides the common pre-defined namespace UUIDs (shown with their
string representation):

    UUID_NS_DNS:  '6ba7b810-9dad-11d1-80b4-00c04fd430c8'
    UUID_NS_URL:  '6ba7b811-9dad-11d1-80b4-00c04fd430c8'
    UUID_NS_OID:  '6ba7b812-9dad-11d1-80b4-00c04fd430c8'
    UUID_NS_X500: '6ba7b814-9dad-11d1-80b4-00c04fd430c8'

=cut

use constant UUID_NS_DNS  =>
    "\x6b\xa7\xb8\x10\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8";
use constant UUID_NS_URL  =>
    "\x6b\xa7\xb8\x11\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8";
use constant UUID_NS_OID  =>
    "\x6b\xa7\xb8\x12\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8";
use constant UUID_NS_X500 =>
    "\x6b\xa7\xb8\x14\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8";

=item B<UUID versions>

This module provides the UUID version numbers as constants:

    UUID_V1
    UUID_V3
    UUID_V4
    UUID_V5

With C<use UUID::Tiny ':std';> you get additional, "speaking" constants:

    UUID_TIME
    UUID_MD5
    UUID_RANDOM
    UUID_SHA1

=cut

use constant UUID_V1 => 1; use constant UUID_TIME   => 1;
use constant UUID_V3 => 3; use constant UUID_MD5    => 3;
use constant UUID_V4 => 4; use constant UUID_RANDOM => 4;
use constant UUID_V5 => 5; use constant UUID_SHA1   => 5;

=item B<UUID_SHA1_AVAIL>

    my $uuid = create_UUID( UUID_SHA1_AVAIL? UUID_V5 : UUID_V3, $str );

This function returns 1 if a module to create SHA-1 digests could be loaded, 0
otherwise.

UUID::Tiny (since version 1.02) tries to load Digest::SHA, Digest::SHA1 or
Digest::SHA::PurePerl, but does not die if none of them is found. Instead
C<create_UUID()> and C<create_UUID_as_string()> die when trying to create an
SHA-1 based UUID without an appropriate module available.

=cut

sub UUID_SHA1_AVAIL {
    return defined $SHA1_CALCULATOR ? 1 : 0;
}

=back

=cut

=head1 FUNCTIONS

All public functions are exported by default (they should not collide with
other functions).

C<create_UUID()> creates standard binary UUIDs in network byte order
(MSB first), C<create_UUID_as_string()> creates the standard string
represantion of UUIDs.

All query and test functions (except C<is_UUID_string>) accept both
representations.

=over 4

=cut

=item B<create_UUID()>, B<create_uuid()> (:std)

    my $v1_mc_UUID   = create_UUID();
    my $v1_mc_UUID   = create_UUID(UUID_V1);
    my $v3_md5_UUID  = create_UUID(UUID_V3, $ns_uuid, $name_or_filehandle);
    my $v3_md5_UUID  = create_UUID(UUID_V3, $name_or_filehandle);
    my $v4_rand_UUID = create_UUID(UUID_V4);
    my $v5_sha1_UUID = create_UUID(UUID_V5, $ns_uuid, $name_or_filehandle);
    my $v5_sha1_UUID = create_UUID(UUID_V5, $name_or_filehandle);

Creates a binary UUID in network byte order (MSB first). For v3 and v5 UUIDs a
C<SCALAR> (normally a string), C<GLOB> ("classic" file handle) or C<IO> object
(i.e. C<IO::File>) can be used; files have to be opened for reading.

I found no hint if and how UUIDs should be created from file content. It seems
to be undefined, but it is useful - so I would suggest to use UUID_NIL as the
namespace UUID, because no "real name" is used; UUID_NIL is used by default if
a namespace UUID is missing (only 2 arguments are used).

=cut

sub create_uuid {
    use bytes;
    my ($v, $arg2, $arg3) = (shift || UUID_V1, shift, shift);
    my $uuid    = UUID_NIL;
    my $ns_uuid = string_to_uuid(defined $arg3 ? $arg2 : UUID_NIL);
    my $name    = defined $arg3 ? $arg3 : $arg2;

    if ($v == UUID_V1) {
        $uuid = _create_v1_uuid();
    }
    elsif ($v == UUID_V3 ) {
        $uuid = _create_v3_uuid($ns_uuid, $name);
    }
    elsif ($v == UUID_V4) {
        $uuid = _create_v4_uuid();
    }
    elsif ($v == UUID_V5) {
        $uuid = _create_v5_uuid($ns_uuid, $name);
    }
    else {
        croak __PACKAGE__ . "::create_uuid(): Invalid UUID version '$v'!";
    }

    # Set variant 2 in UUID ...
    substr $uuid, 8, 1, chr(ord(substr $uuid, 8, 1) & 0x3f | 0x80);

    return $uuid;
}

*create_UUID = \&create_uuid;

sub _create_v1_uuid {
    my $uuid = '';

    # Create time and clock sequence ...
    my $timestamp = Time::HiRes::time();
    my $clk_seq   = _get_clk_seq($timestamp);

    # hi = time mod (1000000 / 0x100000000)
    my $hi = floor( $timestamp / 65536.0 / 512 * 78125 );
    $timestamp -= $hi * 512.0 * 65536 / 78125;
    my $low = floor( $timestamp * 10000000.0 + 0.5 );

    # MAGIC offset: 01B2-1DD2-13814000
    if ( $low < 0xec7ec000 ) {
        $low += 0x13814000;
    }
    else {
        $low -= 0xec7ec000;
        $hi++;
    }

    if ( $hi < 0x0e4de22e ) {
        $hi += 0x01b21dd2;
    }
    else {
        $hi -= 0x0e4de22e;    # wrap around
    }

    # Set time in UUID ...
    substr $uuid, 0, 4, pack( 'N', $low );            # set time low
    substr $uuid, 4, 2, pack( 'n', $hi & 0xffff );    # set time mid
    substr $uuid, 6, 2, pack( 'n', ( $hi >> 16 ) & 0x0fff );    # set time high

    # Set clock sequence in UUID ...
    substr $uuid, 8, 2, pack( 'n', $clk_seq );

    # Set random node in UUID ...
    substr $uuid, 10, 6, _random_node_id();

    return _set_uuid_version($uuid, 0x10);
}

sub _create_v3_uuid {
    my $ns_uuid = shift;
    my $name    = shift;
    my $uuid    = '';

    lock $MD5_CALCULATOR;

    # Create digest in UUID ...
    $MD5_CALCULATOR->reset();
    $MD5_CALCULATOR->add($ns_uuid);

    if ( ref($name) =~ m/^(?:GLOB|IO::)/ ) {
        $MD5_CALCULATOR->addfile($name);
    }
    elsif ( ref $name ) {
        croak __PACKAGE__
            . '::create_uuid(): Name for v3 UUID'
            . ' has to be SCALAR, GLOB or IO object, not '
            . ref($name) .'!'
            ;
    }
    elsif ( defined $name ) {
        $MD5_CALCULATOR->add($name);
    }
    else {
        croak __PACKAGE__
            . '::create_uuid(): Name for v3 UUID is not defined!';
    }

    # Use only first 16 Bytes ...
    $uuid = substr( $MD5_CALCULATOR->digest(), 0, 16 );

    return _set_uuid_version( $uuid, 0x30 );
}

sub _create_v4_uuid {
    # Create random value in UUID ...
    my $uuid = '';
    for ( 1 .. 4 ) {
        $uuid .= pack 'I', _rand_32bit();
    }

    return _set_uuid_version($uuid, 0x40);
}

sub _create_v5_uuid {
    my $ns_uuid = shift;
    my $name    = shift;
    my $uuid    = '';

    if (!$SHA1_CALCULATOR) {
        croak __PACKAGE__
            . '::create_uuid(): No SHA-1 implementation available! '
            . 'Please install Digest::SHA1, Digest::SHA or '
            . 'Digest::SHA::PurePerl to use SHA-1 based UUIDs.'
            ;
    }

    lock $SHA1_CALCULATOR;

    $SHA1_CALCULATOR->reset();
    $SHA1_CALCULATOR->add($ns_uuid);

    if ( ref($name) =~ m/^(?:GLOB|IO::)/ ) {
        $SHA1_CALCULATOR->addfile($name);
    } elsif ( ref $name ) {
        croak __PACKAGE__
            . '::create_uuid(): Name for v5 UUID'
            . ' has to be SCALAR, GLOB or IO object, not '
            . ref($name) .'!'
            ;
    } elsif ( defined $name ) {
        $SHA1_CALCULATOR->add($name);
    } else {
        croak __PACKAGE__
            . '::create_uuid(): Name for v5 UUID is not defined!';
    }

    # Use only first 16 Bytes ...
    $uuid = substr( $SHA1_CALCULATOR->digest(), 0, 16 );

    return _set_uuid_version($uuid, 0x50);
}

sub _set_uuid_version {
    my $uuid = shift;
    my $version = shift;
    substr $uuid, 6, 1, chr( ord( substr( $uuid, 6, 1 ) ) & 0x0f | $version );

    return $uuid;
}

=item B<create_UUID_as_string()>, B<create_uuid_as_string()> (:std)

Similar to C<create_UUID>, but creates a UUID string.

=cut

sub create_uuid_as_string {
    return uuid_to_string(create_uuid(@_));
}

*create_UUID_as_string = \&create_uuid_as_string;

=item B<is_UUID_string()>, B<is_uuid_string()> (:std)

    my $bool = is_UUID_string($str);

=cut

our $IS_UUID_STRING = qr/^[0-9a-f]{8}(?:-[0-9a-f]{4}){3}-[0-9a-f]{12}$/is;
our $IS_UUID_HEX    = qr/^[0-9a-f]{32}$/is;
our $IS_UUID_Base64 = qr/^[+\/0-9A-Za-z]{22}(?:==)?$/s;

sub is_uuid_string {
    my $uuid = shift;
    return $uuid =~ m/$IS_UUID_STRING/;
}

*is_UUID_string = \&is_uuid_string;

=item B<UUID_to_string()>, B<uuid_to_string()> (:std)

    my $uuid_str = UUID_to_string($uuid);

This function returns C<$uuid> unchanged if it is a UUID string already.

=cut

sub uuid_to_string {
    my $uuid = shift;
    use bytes;
    return $uuid
        if $uuid =~ m/$IS_UUID_STRING/;
    croak __PACKAGE__ . "::uuid_to_string(): Invalid UUID!"
        unless length $uuid == 16;
    return  join '-',
            map { unpack 'H*', $_ }
            map { substr $uuid, 0, $_, '' }
            ( 4, 2, 2, 2, 6 );
}

*UUID_to_string = \&uuid_to_string;

=item B<string_to_UUID()>, B<string_to_uuid()> (:std)

    my $uuid = string_to_UUID($uuid_str);

This function returns C<$uuid_str> unchanged if it is a UUID already.

In addition to the standard UUID string representation and its URN forms
(starting with C<urn:uuid:> or C<uuid:>), this function accepts 32 digit hex
strings, variants with different positions of C<-> and Base64 encoded UUIDs.

Throws an exception if string can't be interpreted as a UUID.

If you want to make shure to have a "pure" standard UUID representation, check
with C<is_UUID_string>!

=cut

sub string_to_uuid {
    my $uuid = shift;

    use bytes;
    return $uuid if length $uuid == 16;
    return decode_base64($uuid) if ($uuid =~ m/$IS_UUID_Base64/);
    my $str = $uuid;
    $uuid =~ s/^(?:urn:)?(?:uuid:)?//io;
    $uuid =~ tr/-//d;
    return pack 'H*', $uuid if $uuid =~ m/$IS_UUID_HEX/;
    croak __PACKAGE__ . "::string_to_uuid(): '$str' is no UUID string!";
}

*string_to_UUID = \&string_to_uuid;

=item B<version_of_UUID()>, B<version_of_uuid()> (:std)

    my $version = version_of_UUID($uuid);

This function accepts binary and string UUIDs.

=cut

sub version_of_uuid {
    my $uuid = shift;
    use bytes;
    $uuid = string_to_uuid($uuid);
    return (ord(substr($uuid, 6, 1)) & 0xf0) >> 4;
}

*version_of_UUID = \&version_of_uuid;

=item B<time_of_UUID()>, B<time_of_uuid()> (:std)

    my $uuid_time = time_of_UUID($uuid);

This function accepts UUIDs and UUID strings. Returns the time as a floating
point value, so use C<int()> to get a C<time()> compatible value.

Returns C<undef> if the UUID is not version 1.

=cut

sub time_of_uuid {
    my $uuid = shift;
    use bytes;
    $uuid = string_to_uuid($uuid);
    return unless version_of_uuid($uuid) == 1;

    my $low = unpack 'N', substr($uuid, 0, 4);
    my $mid = unpack 'n', substr($uuid, 4, 2);
    my $high = unpack('n', substr($uuid, 6, 2)) & 0x0fff;

    my $hi = $mid | $high << 16;

    # MAGIC offset: 01B2-1DD2-13814000
    if ($low >= 0x13814000) {
        $low -= 0x13814000;
    }
    else {
        $low += 0xec7ec000;
        $hi --;
    }

    if ($hi >= 0x01b21dd2) {
        $hi -= 0x01b21dd2;
    }
    else {
        $hi += 0x0e4de22e;  # wrap around
    }

    $low /= 10000000.0;
    $hi  /= 78125.0 / 512 / 65536;  # / 1000000 * 0x10000000

    return $hi + $low;
}

*time_of_UUID = \&time_of_uuid;

=item B<clk_seq_of_UUID()>, B<clk_seq_of_uuid()> (:std)

    my $uuid_clk_seq = clk_seq_of_UUID($uuid);

This function accepts UUIDs and UUID strings. Returns the clock sequence for a
version 1 UUID. Returns C<undef> if UUID is not version 1.

=cut

sub clk_seq_of_uuid {
    use bytes;
    my $uuid = shift;
    $uuid = string_to_uuid($uuid);
    return unless version_of_uuid($uuid) == 1;

    my $r = unpack 'n', substr($uuid, 8, 2);
    my $v = $r >> 13;
    my $w = ($v >= 6) ? 3 # 11x
          : ($v >= 4) ? 2 # 10-
          :             1 # 0--
          ;
    $w = 16 - $w;

    return $r & ((1 << $w) - 1);
}

*clk_seq_of_UUID = \&clk_seq_of_uuid;

=item B<equal_UUIDs()>, B<equal_uuids()> (:std)

    my $bool = equal_UUIDs($uuid1, $uuid2);

Returns true if the provided UUIDs are equal. Accepts UUIDs and UUID strings
(can be mixed).

=cut

sub equal_uuids {
    my ($u1, $u2) = @_;
    return unless defined $u1 && defined $u2;
    return string_to_uuid($u1) eq string_to_uuid($u2);
}

*equal_UUIDs = \&equal_uuids;

#
# Private functions ...
#
my $Last_Pid;
my $Clk_Seq;

# There is a problem with $Clk_Seq and rand() on forking a process using
# UUID::Tiny, because the forked process would use the same basic $Clk_Seq and
# the same seed (!) for rand(). $Clk_Seq is UUID::Tiny's problem, but with
# rand() it is Perl's bad behavior. So _init_globals() has to be called every
# time before using $Clk_Seq or rand() ...

sub _init_globals {
    lock $Last_Pid;
    lock $Clk_Seq;

    if (!defined $Last_Pid || $Last_Pid != $$) {
        $Last_Pid = $$;
        # $Clk_Seq = _generate_clk_seq();
        # There's a slight chance to get the same value as $Clk_Seq ...
        for (my $i = 0; $i <= 5; $i++) {
            my $new_clk_seq = _generate_clk_seq();
            if (!defined($Clk_Seq) || $new_clk_seq != $Clk_Seq) {
                $Clk_Seq = $new_clk_seq;
                last;
            }
            if ($i == 5) {
                croak __PACKAGE__
                    . "::_init_globals(): Can't get unique clk_seq!";
            }
        }
        srand();
    }

    return;
}

my $Last_Timestamp;

sub _get_clk_seq {
    my $ts = shift;
    _init_globals();

    lock $Last_Timestamp;
    lock $Clk_Seq;

    #if (!defined $Last_Timestamp || $ts <= $Last_Timestamp) {
    if (defined $Last_Timestamp && $ts <= $Last_Timestamp) {
        #$Clk_Seq = ($Clk_Seq + 1) % 65536;
        # The old variant used modulo, but this looks unnecessary,
        # because we should only use the signigicant part of the
        # number, and that also lets the counter circle around:
        $Clk_Seq = ($Clk_Seq + 1) & 0x3fff;
    }
    $Last_Timestamp = $ts;

    #return $Clk_Seq & 0x03ff; # no longer needed - and it was wrong too!
    return $Clk_Seq;
}

sub _generate_clk_seq {
    my $self = shift;
    # _init_globals();

    my @data;
    push @data, ''  . $$;
    push @data, ':' . Time::HiRes::time();

    # 16 bit digest
    # We should return only the significant part of the number!
    return (unpack 'n', _digest_as_octets(2, @data)) & 0x3fff;
}

sub _random_node_id {
    my $self = shift;

    my $r1 = _rand_32bit();
    my $r2 = _rand_32bit();

    my $hi = ($r1 >> 8) ^ ($r2 & 0xff);
    my $lo = ($r2 >> 8) ^ ($r1 & 0xff);

    $hi |= 0x80;

    my $id  = substr pack('V', $hi), 0, 3;
       $id .= substr pack('V', $lo), 0, 3;

    return $id;
}

sub _rand_32bit {
    _init_globals();
    my $v1 = int(rand(65536)) % 65536;
    my $v2 = int(rand(65536)) % 65536;
    return ($v1 << 16) | $v2;
}

sub _fold_into_octets {
    use bytes;
    my ($num_octets, $s) = @_;

    my $x = "\x0" x $num_octets;

    while (length $s > 0) {
        my $n = '';
        while (length $x > 0) {
            my $c = ord(substr $x, -1, 1, '') ^ ord(substr $s, -1, 1, '');
            $n = chr($c) . $n;
            last if length $s <= 0;
        }
        $n = $x . $n;

        $x = $n;
    }

    return $x;
}

sub _digest_as_octets {
    my $num_octets = shift;

    $MD5_CALCULATOR->reset();
    $MD5_CALCULATOR->add($_) for @_;

    return _fold_into_octets($num_octets, $MD5_CALCULATOR->digest);
}

=back

=cut

=head1 DISCUSSION

=over

=item B<Why version 1 only with random multi-cast MAC addresses?>

The random multi-cast MAC address gives privacy, and getting the real MAC
address with Perl is really dirty (and slow);

=item B<Should version 3 or version 5 be used?>

Using SHA-1 reduces the probabillity of collisions and provides a better
"randomness" of the resulting UUID compared to MD5. Version 5 is recommended
in RFC 4122 if backward compatibility is not an issue.

Using MD5 (version 3) has a better performance. This could be important with
creating UUIDs from file content rather than names.

=back

=head1 UUID DEFINITION

See RFC 4122 (L<http://www.ietf.org/rfc/rfc4122.txt>) for technical details on
UUIDs.

=head1 AUTHOR

Christian Augustin, C<< <mail at caugustin.de> >>

=head1 CONTRIBUTORS

Some of this code is based on UUID::Generator by ITO Nobuaki
E<lt>banb@cpan.orgE<gt>. But that module is announced to be marked as
"deprecated" in the future and it is much too complicated for my liking.

So I decided to reduce it to the necessary parts and to re-implement those
parts with a functional interface ...

Jesse Vincent, C<< <jesse at bestpractical.com> >>, improved version 1.02 with
his tips and a heavy refactoring.

=head1 BUGS

Please report any bugs or feature requests to C<bug-uuid-tiny at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=UUID-Tiny>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc UUID::Tiny

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=UUID-Tiny>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/UUID-Tiny>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/UUID-Tiny>

=item * Search CPAN

L<http://search.cpan.org/dist/UUID-Tiny/>

=back

=head1 ACKNOWLEDGEMENTS

Kudos to ITO Nobuaki E<lt>banb@cpan.orgE<gt> for his UUID::Generator::PurePerl
module! My work is based on his code, and without it I would've been lost with
all those incomprehensible RFC texts and C codes ...

Thanks to Jesse Vincent (C<< <jesse at bestpractical.com> >>) for his feedback, tips and refactoring!

=head1 COPYRIGHT & LICENSE

Copyright 2009, 2010 Christian Augustin, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

ITO Nobuaki has very graciously given me permission to take over copyright for
the portions of code that are copied from or resemble his work (see
rt.cpan.org #53642 L<https://rt.cpan.org/Public/Bug/Display.html?id=53642>).

=cut

1; # End of UUID::Tiny
# ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# THE PREVIOUS MODULE IS COPIED FROM ITS ORIGINAL SOURCE AS IS AND
# THEREFORE IS NOT COVERED BY THE COPYRIGHT NOTICE AT THE BEGINNING OF
# THE FILE.

package main;                   # |:here:|
use POSIX qw( strftime );
use Data::Dumper;
#$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Indent = 0;
use FileHandle;
use strict;

STDERR->autoflush(1);
STDOUT->autoflush(1);

use vars qw (
                $DEBUG
                $VERBOSE
                $SNIPS_PATH
                $SNIPS_DIR
                $SNIPS_CAT
                $SNIPS_CAT_IS_DEFAULT
                $SNIPS_COMMENT_START
                $SNIPS_COMMENT_START_SKIP
                $SNIPS_COMMENT_END
                $SNIPS_COMMENT_END_SKIP
                $SNIPS_COMMENT_START_SEP
                $SNIPS_COMMENT_END_SEP
                $SNIPS_DEF_MODE
                $SNIPS_MODE
                $SNIPS_MODE_IS_DEFAULT
                $SNIPS_MODES
                $SNIPS_MARK
                $SNIPS_BY_CAT
                $SNIPS_BY_NAME
                $opt_ignore_cat_rx
                $opt_accept_cat_rx
                $opt_no_skip
                $opt_no_indent
                $opt_no_final
           );
my $dbg_fwid = 21;

# --------------------------------------------------
# |||:sec:||| CONFIGURATION
# --------------------------------------------------

my $stime = time();
my $time_stamp = strftime( "%Y-%m-%d %H:%M:%S", localtime ( $stime ));

my $double_bar = '||';
my $double_bar_rx = '\|\|';
my $double_bar_quoted = '|@fempty@|';

$DEBUG = 0;
$VERBOSE = 1;

$SNIPS_MARK = 0;
my $SNIPS_MARK_BIT_TAG = ( 1 << 0 );
my $SNIPS_MARK_BIT_NTG = ( 1 << 1 );
my $SNIPS_MARK_BIT_PRC = ( 1 << 2 );

$SNIPS_DIR = '';
if ( exists ( $ENV{SNIPS_DIR} )) {
    $SNIPS_DIR = $ENV{SNIPS_DIR};
}

$SNIPS_PATH = $ENV{HOME}.'/snippets';
if ( exists ( $ENV{SNIPS_PATH} )) {
    $SNIPS_PATH = $ENV{SNIPS_PATH};
} elsif ( $SNIPS_DIR ) {
    $SNIPS_PATH = $SNIPS_DIR;
}

$SNIPS_CAT_IS_DEFAULT = 1;
$SNIPS_CAT = '';
if ( exists ( $ENV{SNIPS_CAT} )) {
    $SNIPS_CAT = $ENV{SNIPS_CAT};
    $SNIPS_CAT_IS_DEFAULT = 0;
}

$SNIPS_COMMENT_START = '#';
if ( exists ( $ENV{SNIPS_COMMENT_START} )) {
    $SNIPS_COMMENT_START = $ENV{SNIPS_COMMENT_START};
}
$SNIPS_COMMENT_START_SKIP = '#+ *';
if ( exists ( $ENV{SNIPS_COMMENT_START_SKIP} )) {
    $SNIPS_COMMENT_START_SKIP = $ENV{SNIPS_COMMENT_START_SKIP};
}
$SNIPS_COMMENT_END = '';
if ( exists ( $ENV{SNIPS_COMMENT_END} )) {
    $SNIPS_COMMENT_END = $ENV{SNIPS_COMMENT_END};
}
$SNIPS_COMMENT_END_SKIP = '';
if ( exists ( $ENV{SNIPS_COMMENT_END_SKIP} )) {
    $SNIPS_COMMENT_END_SKIP = $ENV{SNIPS_COMMENT_END_SKIP};
}
$SNIPS_COMMENT_START_SEP = '# ';
if ( exists ( $ENV{SNIPS_COMMENT_START_SEP} )) {
    $SNIPS_COMMENT_START_SEP = $ENV{SNIPS_COMMENT_START_SEP};
}
$SNIPS_COMMENT_END_SEP = '';
if ( exists ( $ENV{SNIPS_COMMENT_END_SEP} )) {
    $SNIPS_COMMENT_END_SEP = $ENV{SNIPS_COMMENT_END_SEP};
}

$SNIPS_BY_CAT = {};
$SNIPS_BY_NAME = [];

# --------------------------------------------------
# |||:sec:||| string replacements
# --------------------------------------------------

use vars qw ( $SNIPS_REPLACEMENTS $SNIPS_REPLACEMENTS_FINAL $SNIPS_REPLACEMENTS_USER );
$SNIPS_REPLACEMENTS_USER = {};
$SNIPS_REPLACEMENTS = {};
$SNIPS_REPLACEMENTS_FINAL = {};

# |:todo:| use snip_setup
my $empty = '';
snip_set_at_replacement ( 'empty', $empty );

# |:todo:| use snip_setup
my $fempty = '';
snip_set_at_replacement_final ( 'fempty', $empty );

# |:todo:| use snip_setup
my $nl = "\n";
snip_set_at_replacement ( 'nl', $nl );

snip_set_at_replacement ( 'tag_pfx', ':' );
snip_set_at_replacement ( 'tag_sfx', ':' );

# --------------------------------------------------
# |||:sec:||| modes
# --------------------------------------------------

my $snm_indx_mode = 0;
my $snm_indx_cat = 1;
my $snm_indx_comm = 2;
my $snm_indx_hf = 3;
my $snm_indx_new = 4;

$SNIPS_DEF_MODE = 'text';

$SNIPS_MODE = '';
$SNIPS_MODE_IS_DEFAULT = 0;
if ( exists ( $ENV{SNIPS_MODE} )) {
    $SNIPS_MODE = $ENV{SNIPS_MODE};
}

$SNIPS_MODES = {};

# |:info:| generic mode with new comment syntax
snip_add_mode ([ 'generic',
                 [ "gen" ],
                 [ '@:comm@', '\@:[bl]?comm_?\@', '@:comme@', '\@:(_b?comm|b?comme|#)\@', '@:comm_@', '@:_comm@' ],
                 # [ ],           # no special header / footer
                 # [ ],           # no special snippet for --new
               ]);
snip_add_mode ( 'gen' => 'generic' );
{
    my $mode = snip_add_mode ( 'snip' => 'generic' );
    $mode->[ $snm_indx_cat ] = [ 'snip', @{$mode->[ $snm_indx_cat ]} ];
}
snip_set_at_replacement ( ':comm_line', '@:comm@@:_comm@', 1 );
snip_set_at_replacement ( ':lcomm', '' );
snip_set_at_replacement ( ':lcomm_', '' );

# generic mode with old comment syntax
snip_add_mode ([ 'xgeneric',
                 [ "xgen" ],
                 [ '@comm@', '\@[bl]?comm_?\@', '@comme@', '\@(_b?comm|b?comme)\@', '@comm_@', '@_comm@' ],
                 # [ ],           # no special header / footer
                 # [ ],           # no special snippet for --new
               ]);
snip_add_mode ( 'xgen' => 'xgeneric' );
snip_set_at_replacement ( 'comm_line', '@:comm@@:_comm@', 1 );
snip_set_at_replacement ( 'lcomm', '' );
snip_set_at_replacement ( 'lcomm_', '' );

my $sn_perl_header = <<__EOS__;
#!/usr/bin/env perl -w

# ||<-snap->|| default title template for perl(1) programs
# ||<-snap->|| title \@title\@
$empty
__EOS__
snip_add_mode ([ 'perl',
                 [ "pl", "hd", "gen" ],
                 [ '#', '#+' ],
                 [ $sn_perl_header ],
               ]);
snip_add_mode ( 'cperl' => 'perl' );
snip_add_mode ( 'pl' => 'perl' );
snip_add_mode ( 'pm' => 'perl', 0, 'pl_new-pm' );

my $sn_python_header = <<__EOS__;
#!/usr/bin/env python
# -*- coding: utf-8 -*-

# ||<-snap->|| default title Python Snippet
# ||<-snap->|| title \@title\@
$empty
__EOS__
snip_add_mode ([ 'python',
                 [ "py", "hd", "gen" ],
                 [ '#', '#+' ],
                 [ $sn_python_header ],
               ]);
snip_add_mode ( py => 'python' );

my $sn_sh_header = <<__EOS__;
#!/bin/sh

# ||<-snap->|| default title Shell Script Snippet
# ||<-snap->|| title \@title\@
$empty
__EOS__
snip_add_mode ([ 'sh',
                 [ "sh", "hd", "gen" ],
                 [ '#', '#+' ],
                 [ $sn_sh_header ],
               ]);
snip_add_mode ( shell => 'sh' );
snip_add_mode ( bash => 'sh' );

snip_add_mode ([ 'makefile',
                 [ "mak", "gen" ],
                 [ '#', '#+' ],
               ]);
snip_add_mode ( mak => 'makefile' );
snip_add_mode ( 'makefile-gmake' => 'makefile' );

snip_add_mode ([ 'emacs-lisp',
                 [ "el", "gen" ],
                 [ ';;', ';+', '' ],
               ]);
snip_add_mode ( el => 'emacs-lisp' );

snip_add_mode ([ 'sql',
                 [ "sql", "gen" ],
                 [ '--', '--' ],
               ]);

snip_add_mode ([ 'c',
                 [ "c", "h", "gen" ],
                 [ '/*', '/\*+', '*/' ],
               ]);
snip_add_mode ( 'h' =>
                [ 'c',
                  [ "h", "hxx", "gen" ],
                  $SNIPS_MODES->{c}->[ $snm_indx_comm ],
                ]);
snip_add_mode ([ 'css',
                 [ "css", "gen" ],
                 $SNIPS_MODES->{'c'}->[ $snm_indx_comm ],
               ]);

snip_add_mode ([ 'c++',
                 [ "cxx", "c", "hxx", "h", "gen" ],
                 [ '//', '//+' ],
               ]);

snip_add_mode ([ 'javascript',
                 [ "js", "gen" ],
                 [ '//', '//+' ],
               ]);
snip_add_mode ( 'js' => 'javascript' );

snip_add_mode ([ 'html',
                 [ "html", "js", "css", "gen" ],
                 [ '<!--', '<!--', '-->' ],
               ]);
snip_add_mode ([ 'php',
                 [ "php", "gen" ],
                 $SNIPS_MODES->{'c++'}->[ $snm_indx_comm ],
               ]);

# generic text mode
snip_add_mode ([ 'text',
                 [ "txt", "url", "file", "pipe", "gen" ],
                 [ '', '', '' ],
               ]);
snip_add_mode ( 'txt' => 'text' );
snip_add_mode ( 'url' => 'text' );
snip_add_mode ( 'file' => 'text' );
snip_add_mode ( 'pipe' => 'text' );
snip_add_mode ( 'fundamental' => 'text', 1 ); # also set emacs mode
snip_add_mode ( 'dired' => 'text' );
snip_add_mode ( 'info' => 'text' )->[ $snm_indx_cat ] = [ "info" ];

# reStructuredText
{
    my $mode = snip_add_mode ( 'rst' => 'text', 1, 'rst_new' );
    $mode->[ $snm_indx_cat ] = [ 'rst', @{$mode->[ $snm_indx_cat ]} ];
    $mode->[ $snm_indx_comm ] = [ '..', '\.\. |\.\. \\\\' ];
}

# reStructuredText for tutorial
{
    my $mode = snip_add_mode ( 'rstt' => 'text', 1, 'rstt_new' );
    $mode->[ $snm_indx_cat ] = [ 'rstt', @{$mode->[ $snm_indx_cat ]} ];
    $mode->[ $snm_indx_comm ] = [ '..', '\.\. |\.\. \\\\' ];
}

# add major category
{
    my $mode = snip_add_mode ( 'whereis' => 'text', 0, 'whereis_new' );
    $mode->[ $snm_indx_cat ] = [ 'whereis', @{$mode->[ $snm_indx_cat ]} ];
}

snip_consolidate_modes ();

# --------------------------------------------------
# |||:sec:||| comments
# --------------------------------------------------

my $comment_start_skip_rx;
my $comment_end_skip_rx;

sub snips_setup_comments {
# setup comment parameters
    my $comment_start_skips = {};
    my $comment_end_skips = {};
    foreach my $mode (keys(%{$SNIPS_MODES})) {
        my $mode_settings = $SNIPS_MODES->{$mode};
        my $comment_start_skip = $mode_settings->[ $snm_indx_comm ]->[ 1 ];
        $comment_start_skips->{$comment_start_skip} = 1;
        my $comment_end_skip = $mode_settings->[ $snm_indx_comm ]->[ 3 ];
        if ( $comment_end_skip ) {
            $comment_end_skips->{$comment_end_skip} = 1;
        }
    }
    delete ( $comment_start_skips->{''} );
    $comment_start_skip_rx = join ( '|', sort(keys(%{$comment_start_skips})));
    delete ( $comment_end_skips->{''} );
    $comment_end_skip_rx = join ( '|', sort(keys(%{$comment_end_skips})));

    snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
               'comment_start_skip_rx', $comment_start_skip_rx ) if $DEBUG > 5;
    snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
               'comment_end_skip_rx', $comment_end_skip_rx ) if $DEBUG > 5;
}

snips_setup_comments();

# --------------------------------------------------
# |||:sec:||| OPTION LOOP
# --------------------------------------------------

my @opt_dirs = ();
my $opt_dir_seen = 0;
$opt_ignore_cat_rx = '^(none)$';
my $opt_ignore_cat_seen = 0;
$opt_accept_cat_rx = '';
my $opt_accept_cat_seen = 0;
my $opt_mode = '';
my $opt_mode_main_only = 0;
my $opt_mode_seen = 0;

my $opt_title = '';
my $opt_uuid = UUID::Tiny::create_UUID_as_string
    (UUID::Tiny::UUID_V3, UUID::Tiny::UUID_NS_OID,
     UUID::Tiny::create_UUID_as_string());
snip_set_at_replacement('uuid', $opt_uuid);
snip_set_at_replacement('snip_uuid_last', $opt_uuid);

my $cmd_seen = 0;

my $opt_list = 0;
my $opt_grep = 0;
my $opt_as_includes = 0;
my $opt_fn_sep = '#';

my $opt_cat = 0;
my $opt_temp_snippet = '';
my $opt_all = 0;

my $opt_new = 0;
my $opt_replace = 0;
my $opt_replace_seen = 0;
my $opt_no_replace_seen = 0;
my $opt_process = 0;
my $opt_process_seen = 0;
my $opt_no_process_seen = 0;
$opt_no_skip = 0;
my $opt_no_skip_seen = 0;
$opt_no_indent = 0;
my $opt_no_indent_seen = 0;
$opt_no_final = 0;
my $opt_no_final_seen = 0;

my $opt_store = 0;
my $opt_append = 0;
my $opt_literal = 0;
my $opt_use_hdr = 0;
my $opt_use_ftr = 0;

my $opt_work = 0;

my $opt_force = 0;

my $opt_name_rx = '';
my @opt_grep_opts = ();
my $opt_grep_opts = '';
my $opt_name = '';
my $opt_filename = '';

my @orig_cmd_line = ( $0, @ARGV );

my $last_repl_key;

my $usage_opts = '';

OPT:
while ( $#ARGV >= 0 ) {
    # --debug
    if ( $ARGV[ 0 ] =~ /^-(-de([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        $VERBOSE = 1;
        if ( $2 ) {
            $DEBUG = $3;
        } else {
            ++$DEBUG;
        }
        next OPT;
    }

    if ( $prog_name eq 'snw' ) {
        last OPT;
    }
    if ( $prog_name eq 'sng' ) {
        last OPT;
    }

    # --help
    if ( $ARGV[ 0 ] =~ /^-(\?|h|-h)/ ) {
        usage ( *STDOUT, 0, 0, $usage_opts);
        exit 0;
    }
    # --rst-help
    if ( $ARGV[ 0 ] =~ /^-(-rst-h)/ ) {
        usage ( *STDOUT, 1, 0, $usage_opts );
        exit 0;
    }
    # --rst-min-help
    if ( $ARGV[ 0 ] =~ /^-(-rst-m)/ ) {
        usage ( *STDOUT, 1, 1, $usage_opts );
        exit 0;
    }
    # --install
    if ( $ARGV[ 0 ] =~ /^-(-install)$/ ) {
        shift ( @ARGV );
        my $inst_bin_dir = shift ( @ARGV );
        if ( !$inst_bin_dir ) {
            $inst_bin_dir = '/usr/local/bin';
        }
        system ( "cp -p '".sq ( $0 )."' '".sq ( $inst_bin_dir.'/snippets' )."'" );
        # :shortcut:
        foreach my $shortcut ( 'snh', 'snl', 'sng', 'sni', 'snc', 'snr', 'snn', 'sna', 'sns', 'snw' ) {
            system ( "rm -f '".sq ( $inst_bin_dir.'/'.$shortcut )."'" );
            system ( "ln -s snippets '".sq ( $inst_bin_dir.'/'.$shortcut )."'" );
        }
        exit ( 0 );
    }
    # --dist
    if ( $ARGV[ 0 ] =~ /^-(-dist)/ ) {
        shift ( @ARGV );
        my $dist_dir = shift ( @ARGV );
        if ( !$dist_dir ) {
            $dist_dir = '/srv/ftp/pub';
        }
        system ( "cp -p '".sq ( $0 )."' '".sq ( $dist_dir.'/snippets.pl' )."'" );
        exit ( 0 );
    }

    # --quiet
    if ( $ARGV[ 0 ] =~ /^-(q|-q)/ ) {
        shift ( @ARGV );
        $VERBOSE=0;
        next OPT;
    }
    # --verbose
    if ( $ARGV[ 0 ] =~ /^-(-ve)/ ) {
        shift ( @ARGV );
        ++$VERBOSE;
        next OPT;
    }
    # --dir
    if ( $ARGV[ 0 ] =~ /^-(d|-di([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $SNIPS_DIR = $3;
        } else {
            $SNIPS_DIR = shift ( @ARGV );
        }
        $SNIPS_PATH = $SNIPS_DIR.':'.$SNIPS_PATH;
        push ( @opt_dirs, $SNIPS_DIR );
        $opt_dir_seen = 1;
        next OPT;
    }
    # --accept-cat
    if ( $ARGV[ 0 ] =~ /^-(-ac([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_accept_cat_rx = $3;
        } else {
            $opt_accept_cat_rx = shift ( @ARGV );
        }
        $opt_accept_cat_seen = 1;
        next OPT;
    }
    # --ignore-cat
    if ( $ARGV[ 0 ] =~ /^-(i|-ig([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_ignore_cat_rx = $3;
        } else {
            $opt_ignore_cat_rx = shift ( @ARGV );
        }
        $opt_ignore_cat_seen = 1;
        next OPT;
    }
    # --mode
    if ( $ARGV[ 0 ] =~ /^-(m|-mo([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_mode = $3;
        } else {
            $opt_mode = shift ( @ARGV );
        }
        $opt_mode_seen = 1;
        # |:check:| why?
        # if ( $opt_mode ) {
        #     $opt_accept_cat_seen = 0;
        # }
        next OPT;
    }
    # --title
    if ( $ARGV[ 0 ] =~ /^-(t|-t([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_title = $3;
        } else {
            $opt_title = shift ( @ARGV );
        }
        snip_set_at_replacement('title', $opt_title);
        snip_set_at_replacement('snip_title_last', $opt_title);
        next OPT;
    }
    # --uuid
    if ( $ARGV[ 0 ] =~ /^-(u|-u([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_uuid = $3;
        } else {
            $opt_uuid = shift ( @ARGV );
        }
        snip_set_at_replacement('uuid', $opt_uuid);
        snip_set_at_replacement('snip_uuid_last', $opt_uuid);
        next OPT;
    }
    # --main-only
    if ( $ARGV[ 0 ] =~ /^-(-mai)/ ) {
        shift ( @ARGV );
        $opt_mode_main_only = 1;
        next OPT;
    }
    # --force
    if ( $ARGV[ 0 ] =~ /^-(f|-fo)/ ) {
        shift ( @ARGV );
        $opt_force = 1;
        next OPT;
    }

    # --list
    if ( $ARGV[ 0 ] =~ /^-(l|-lis([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_name_rx = $3;
        } else {
            $opt_name_rx = shift ( @ARGV );
        }
        $opt_list = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--list' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # --grep
    if ( $ARGV[ 0 ] =~ /^-(g|-g)/ ) {
        shift ( @ARGV );
        @opt_grep_opts = @ARGV;
        $opt_grep = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--grep' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # for --list/--grep
    {
        # --as-includes
        if ( $ARGV[ 0 ] =~ /^-(-as)/ ) {
            shift ( @ARGV );
            $opt_as_includes = 1;
            next OPT;
        }
        # --fn-sep
        if ( $ARGV[ 0 ] =~ /^-(-fn([^=]*=(.*))?)/ ) {
            shift ( @ARGV );
            if ( $2 ) {
                $opt_fn_sep = $3;
            } else {
                $opt_fn_sep = shift ( @ARGV );
            }
            next OPT;
        }
    }

    # --cat
    if ( $ARGV[ 0 ] =~ /^-(c|-c([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_name_rx = $3;
        } else {
            $opt_name_rx = shift ( @ARGV );
        }
        $opt_temp_snippet = shift ( @ARGV );
        $opt_cat = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--cat' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # for --cat
    {
        # --all
        if ( $ARGV[ 0 ] =~ /^-(-al)/ ) {
            shift ( @ARGV );
            $opt_all = 1;
            next OPT;
        }
    }

    # --new
    if ( $ARGV[ 0 ] =~ /^-(n|-ne([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_filename = $3;
        } else {
            $opt_filename = shift ( @ARGV );
        }
        $opt_name = shift ( @ARGV );
        $opt_new = 1;
        if ( !$opt_no_replace_seen ) {
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
        }
        if ( !$opt_no_process_seen ) {
            $opt_process = 1;
            $opt_process_seen = 1;
            $opt_no_process_seen = 0;
        }
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--new' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # for --cat/--new
    {
        # --mark
        if ( $ARGV[ 0 ] =~ /^-(-mar([^=]*=(.*))?)/ ) {
            shift ( @ARGV );
            if ( $2 ) {
                $SNIPS_MARK = $3;
            } else {
                ++$SNIPS_MARK;
            }
            next OPT;
        }
        # --replace
        if ( $ARGV[ 0 ] =~ /^-(r|-re)/ ) {
            shift ( @ARGV );
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
            next OPT;
        }
        # --no-replace
        if ( $ARGV[ 0 ] =~ /^-(-no-r)/ ) {
            shift ( @ARGV );
            $opt_replace = 0;
            $opt_replace_seen = 0;
            $opt_no_replace_seen = 1;
            next OPT;
        }
        # --no-final
        if ( $ARGV[ 0 ] =~ /^-(-no-f)/ ) {
            shift ( @ARGV );
            $opt_no_final = 1;
            $opt_no_final_seen = 1;
            $usage_opts .= ' --no-final';
            next OPT;
        }
        # --process
        if ( $ARGV[ 0 ] =~ /^-(p|-p)/ ) {
            shift ( @ARGV );
            $opt_process = 1;
            $opt_process_seen = 1;
            $opt_no_process_seen = 0;
            next OPT;
        }
        # --no-process
        if ( $ARGV[ 0 ] =~ /^-(-no-p)/ ) {
            shift ( @ARGV );
            $opt_process = 0;
            $opt_process_seen = 0;
            $opt_no_process_seen = 1;
            next OPT;
        }
        # --no-skip
        if ( $ARGV[ 0 ] =~ /^-(-no-s)/ ) {
            shift ( @ARGV );
            $opt_no_skip = 1;
            $opt_no_skip_seen = 1;
            next OPT;
        }
        # --no-indent
        if ( $ARGV[ 0 ] =~ /^-(-no-i)/ ) {
            shift ( @ARGV );
            $opt_no_indent = 1;
            $opt_no_indent_seen = 1;
            next OPT;
        }
        # --key
        if ( $ARGV[ 0 ] =~ /^-(k|-k([^=]*=(.*))?)/ ) {
            shift ( @ARGV );
            if ( $2 ) {
                $last_repl_key = $3;
            } else {
                $last_repl_key = shift ( @ARGV );
            }
            if ( !$last_repl_key ) {
                snip_msg ( "error: Invalid empty key\n" );
                exit ( 1 );
            }
            my @nkeys = snip_normalize_at_key( $last_repl_key );
            if ( $last_repl_key eq $nkeys[ 0 ]) {
                snip_msg("warning: deprecated full key specification `--key %s`. use `--key %s`\n",
                         $nkeys[0], $nkeys[1]);
                $last_repl_key = $nkeys[ 1 ];
            }
            snip_set_user_at_replacement ( $last_repl_key, '' );
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
            next OPT;
        }
        # --value
        if ( $ARGV[ 0 ] =~ /^-(v|-va([^=]*=(.*))?)/ ) {
            my $value;
            shift ( @ARGV );
            if ( $2 ) {
                $value = $3;
            } else {
                $value = shift ( @ARGV );
            }
            if ( !$last_repl_key ) {
                snip_msg ( "error: No key available for --val=`%s`\n", $value );
                exit ( 1 );
            }
            snip_set_user_at_replacement ( $last_repl_key, $value );
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
            next OPT;
        }
    }

    # --store
    if ( $ARGV[ 0 ] =~ /^-(s|-s([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_name = $3;
        } else {
            $opt_name = shift ( @ARGV );
        }
        $opt_store = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--store' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # --append
    if ( $ARGV[ 0 ] =~ /^-(a|-ap([^=]*=(.*))?)/ ) {
        shift ( @ARGV );
        if ( $2 ) {
            $opt_name = $3;
        } else {
            $opt_name = shift ( @ARGV );
        }
        $opt_append = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--append' || '' ) if $DEBUG > 4;
        next OPT;
    }
    # for --store/--append
    {
        # --literal
        if ( $ARGV[ 0 ] =~ /^-(-lit)/ ) {
            shift ( @ARGV );
            $opt_literal = 1;
            next OPT;
        }
        # --use-header
        if ( $ARGV[ 0 ] =~ /^-(-use-h)/ ) {
            shift ( @ARGV );
            $opt_use_hdr = 1;
            next OPT;
        }
        # --use-footer
        if ( $ARGV[ 0 ] =~ /^-(-use-f)/ ) {
            shift ( @ARGV );
            $opt_use_ftr = 1;
            next OPT;
        }
        # --use-both
        if ( $ARGV[ 0 ] =~ /^-(-use-b)/ ) {
            shift ( @ARGV );
            $opt_use_hdr = 1;
            $opt_use_ftr = 1;
            next OPT;
        }
    }

    # --work
    if ( $ARGV[ 0 ] =~ /^-(w|-w)/ ) {
        shift ( @ARGV );
        $opt_work = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", '--work' || '' ) if $DEBUG > 4;
        last OPT;
    }

    # -- end of options
    if ( $ARGV[ 0 ] eq '--' ) {
        shift ( @ARGV );
        last OPT;
    }
    # - standard input
    if ( $ARGV[ 0 ] eq '-' ) {
        last OPT;
    }
    # -- unknown option
    if ( $ARGV[ 0 ] =~ /^-(|-)/ ) {
        snip_msg ( "error: unknown option `%s`\n", $ARGV[ 0 ]);
        exit ( 1 );
    }
    last OPT;
}

snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "ARGV ORIG",
           join ( ', ', map { "'".sq ( dbg_trunc_str ( $_ ))."'"; } @orig_cmd_line ) || '' )
    if $DEBUG;
snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "ARGV $cmd_seen",
           join ( ', ', map { "'".sq ( dbg_trunc_str ( $_ ))."'"; } @ARGV ) || '' )
    if $DEBUG > 4;
snip_handle_shortcut ( $prog_name, $cmd_seen );
snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "ARGV $cmd_seen",
           join ( ', ', map { "'".sq ( dbg_trunc_str ( $_ ))."'"; } @ARGV ) || '' )
    if $DEBUG > 4;

# --------------------------------------------------
# |||:sec:||| SETUP
# --------------------------------------------------

# :struct: snips_setup Setup SNIPS parameters
# :struct: snips_default_command Determine default command
# i no command was specified
# t use --list as command
# -
# :struct:
if ( !$cmd_seen ) {
    $opt_list = 1;
    $opt_name_rx = shift ( @ARGV );
}

snip_consolidate_modes ();
snip_setup_comments ();
if ( $DEBUG > 5 ) {
    foreach my $mode_name ( sort ( keys ( %{$SNIPS_MODES} ))) {
        my $mode = $SNIPS_MODES->{$mode_name};
        snip_msg ( "#  ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, 'mode' || '',
                   Data::Dumper->Dump([ $mode ], [ $mode_name ]));
    }
}

# :struct: snips_determine_mode Determine SNIPS_MODE
# i option --mode was specified
# t override SNIPS_MODE
# e use environment variable SNIPS_MODE
# -
# i option --list was not specified
# t set snip_default_mode()
# -
# :struct:
if ( $opt_mode_seen ) {
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_mode", $opt_mode || '' )
        if $DEBUG > 4;
    $SNIPS_MODE = $opt_mode;
} else {
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "default_mode", $SNIPS_MODE || '' )
        if $DEBUG > 4;
    $opt_mode = $SNIPS_MODE;
}
if ( !$opt_list && !$opt_mode ) {
    $opt_mode = snip_default_mode();
    $SNIPS_MODE_IS_DEFAULT = 1;
}
if ( $opt_mode ) {
    snip_set_mode ( $opt_mode, $opt_mode_main_only );
}

# if no ignore category rx is set, do not ignore anything.
if ( !$opt_ignore_cat_rx ) {
    $opt_ignore_cat_rx = '^$';
}

# if no accept category rx is set, accept everything.
if ( !$opt_accept_cat_rx ) {
    if ( $SNIPS_CAT ) {
        $opt_accept_cat_rx = '^('.$SNIPS_CAT.')$';
    } else {
        $opt_accept_cat_rx = '.*';
    }
}

# if no name rx is set, accept all names.
if ( !$opt_name_rx ) {
    $opt_name_rx = '.*';
}

# setup SNIPS_PATH
my @snips_path_dirs;
sub setup_path {
    my $snips_dirs_seen = {};
    foreach ( split ( /:/, $SNIPS_PATH ), $SNIPS_DIR ) {
        if ( !$_ ) {
            next;
        }
        if ( $snips_dirs_seen->{$_} ) {
            next;
        }
        push ( @snips_path_dirs, $_ );
        $snips_dirs_seen->{$_} = 1;
    }

    # use first global snippets repository as default
    if ( !$SNIPS_DIR ) {
        $SNIPS_DIR = $snips_path_dirs[ 0 ];
    }

    # look for local .snippets directories
    use Cwd;                    # import names from Cwd::
    my $here = getcwd();
    my @parts = split(/\//, $here);
    my @path;
    while (@parts) {
        my $dir = join('/', @parts).'/.snippets';
        if ( -d $dir) {
            push(@path, $dir);
        }
        pop(@parts);
    }
    @snips_path_dirs = (@path, @snips_path_dirs);

    # effective SNIPS_PATH
    $SNIPS_PATH = join ( ':', @snips_path_dirs );
}
setup_path();

# |||:sec:||| special setup for --new
if ( $opt_new ) {
    if ( !$opt_filename ) {
        $opt_filename = '-';
    }
    my $rep_filename = $opt_filename;
    my $ext_filename = $opt_filename;
    my $ext;
    if ( $opt_filename  eq '-' ) {
        $rep_filename = snip_get_at_replacement ( 'filename' );
        if ( $rep_filename ) {
            $ext_filename = $rep_filename;
        } else {
            $rep_filename = '<stdout>';
        }
    }
    if ( !$opt_mode_seen ) {
        # use file extension, if no SNIPS_MODE was explicitely set
        if ( $ext_filename =~ m,[.]([^.]+)$,so ) {
            $ext = $1;
            if ( exists ( $SNIPS_MODES->{$ext} )) {
                $SNIPS_MODE = $ext;
            }
        }
        # use snippet prefix, if no SNIPS_MODE was explicitely set
        if ( !$SNIPS_MODE && $ext_filename =~ m/^([^_]+)_/ ) {
            my $pfx = $1;
            if ( exists ( $SNIPS_MODES->{$pfx} )) {
                $SNIPS_MODE = $pfx;
            }
        }
    }
    if ( !$SNIPS_MODE ) {
        $SNIPS_MODE = snip_default_mode ( $ext );
    }
    snip_set_mode ( $SNIPS_MODE, $opt_mode_main_only );
    if ( !snip_get_at_replacement ( 'filename' )) {
        snip_set_at_replacement ( 'filename', $rep_filename );
    }
    if ( !$opt_name ) {
        $opt_name = $SNIPS_MODES->{$SNIPS_MODE}->[ $snm_indx_new ];
    }
}
# :struct:

# --------------------------------------------------
# |||:sec:||| FUNCTIONS
# --------------------------------------------------

sub sq {
    local ( $_ ) = shift;
    s,','\\'',sg;
    return $_;
}

sub sqe {
    return "'".sq(@_)."'";
}

sub repr {
    use Data::Dumper;
    local ($Data::Dumper::Purity) = 1;
    local ($Data::Dumper::Terse) = 1;
    local ($Data::Dumper::Sortkeys) = 1;
    local ($Data::Dumper::Indent) = 0;
    my $var = shift;
    local $SIG{__WARN__} = sub {};
    return Dumper($var);
}

sub dbg_flatten_str {
    local ( $_ ) = shift;
    s,\\,\\\\,sog;
    s,\t,\\t,sog;
    s,\r,\\r,sog;
    s,\n,\\n,sog;
    return $_;
}

sub dbg_trunc_str {
    local ( $_ ) = shift;
    my $max_len = shift || 60;
    if ( length ( $_ ) > $max_len ) {
        $_ = substr ( $_, 0, $max_len );
    }
    return dbg_flatten_str($_);
}

my $dbg_max_depth = 3;

sub dbg_format_if_array {
    my $maybe_array = shift;
    my $max_level = shift || $dbg_max_depth;
    my $level = shift || 0;
#    return $maybe_array;       # |:debug:|
    if ( !defined ( $maybe_array )) {
        return 'undef';
    }
    if ($level>$dbg_max_depth) {
        my $ref = ref($maybe_array);
        if ($ref eq 'ARRAY') {
            my $len = scalar(@{$maybe_array});
            if ( !$len ) {
                return '[]';
            }
            return sprintf("%s(%s)", $ref, $len);
        } elsif ($ref eq 'HASH') {
            my $len = scalar(%{$maybe_array});
            if ( !$len ) {
                return '{}';
            }
            return sprintf("%s(%s)", $ref, $len);
        }
        return $maybe_array;
    }
    if (ref($maybe_array) eq 'ARRAY') {
        return ("[".join(', ', map { dbg_format_if_array($_, $max_level, $level + 1); } @{$maybe_array} )."]");
    } elsif (ref($maybe_array) eq 'HASH') {
        return "{".join
            (', ',
             map { sprintf("%s => %s", $_, dbg_format_if_array($maybe_array->{$_}, $max_level, $level + 1)); }
             sort(keys(%{$maybe_array}))
            )."}";
    }
    if ( $maybe_array =~ m/^[0-9]+$/so) {
        return dbg_flatten_str( $maybe_array);
    }
    return "'".sq( dbg_flatten_str( $maybe_array))."'";
}

# --------------------------------------------------
# Convert an integer into a binary string representation.
#
# STRING = binf ( INTEGER[, BIT-LENGTH[, BYTE-SEP[, NIBBLE-SEP ]]])
sub binf {
    my $int = shift;
    my $out_wid = shift || 32;
    my $byte_sep = shift || ' ';
    my $nib_sep = shift || '';
    my @bin = ();

    my $conv_tot_wid = int (( $out_wid + 7 ) / 8 ) * 8;
    my $conv_cur_wid = 0;
    while ( $conv_cur_wid < $conv_tot_wid ) {
        my $byte = unpack ( 'B8', chr ( $int & 0xFF ));
        unshift ( @bin, substr ( $byte, 0, 4 ).$nib_sep.substr ( $byte, 4 ));
        $int >>= 8;
        $conv_cur_wid += 8;
    }
    my $trunc = $conv_tot_wid - $out_wid;
    if ( $trunc > 3 ) {
        $trunc += length ( $nib_sep );
    }
    $bin[ 0 ] = substr ( $bin[ 0 ], $trunc );
    return join ( $byte_sep, @bin );
}

# snips_read_file ( FILE[, QUIET] )
sub snips_read_file {
    my $file = shift;
    my $quiet = shift;
    local ( *FILE );
    my $snip_txt = '';
    my $sv_rs= $/;
    $@ = '';
    if ( $file eq '-' ) {
        undef $/;
        $snip_txt = <>;
    } else {
        my $prefix = '<';
        if ( $file =~ m/[|][ \t\r\n]*$/so) {
            $prefix = '';
        }
        if ( !open ( FILE, $prefix.$file )) {
            $@ = sprintf("could not open file `%s`", $file);
            snip_msg ( "warning: %s\n", $@ ) unless $quiet;
            return $snip_txt;
        }
        undef $/;
        $snip_txt = <FILE>;
        close ( FILE );
    }
    $/ = $sv_rs;
    return $snip_txt;
}

sub snip_comment {
    my $str = shift;
    if ( !$str ) {
        return $str;
    }
    my $pfx = $SNIPS_COMMENT_START_SEP;
    my $sfx = $SNIPS_COMMENT_END_SEP;
    if ( !$pfx && !$sfx ) {
        return $str;
    }
    my $head = '';
    my $body = $str;
    my $tail = '';
    if ( $str =~ m,^\n+,so ) {
        $head = $&;
        $body = $';
    }
    if ( $body =~ m,\n+$,so ) {
        $body = $`;
        $tail = $&;
    }
    if ( !$body ) {
        return $str;
    }
    $body =~ s,\n+,$sfx\n$pfx,sg;
    return $head.$pfx.$body.$sfx.$tail;
}

sub snip_commentf {
    my $format = shift;
    return snip_comment ( sprintf ( $format, @_ ));
}

my $snip_capture_stack = [];
my $snip_capture_context = [ 0, ''];

sub snip_capture_start {
    my $text = $snip_capture_context->[1];
    push(@{$snip_capture_stack}, $snip_capture_context );
    $snip_capture_context = [ 1, ''];
    return $text
}

sub snip_capture_stop {
    my $text = $snip_capture_context->[1];
    $snip_capture_context = pop(@{$snip_capture_stack});
    return $text
}

sub snip_msg {
    my $msg = snip_commentf ( @_ );
    $snip_capture_context->[1] .= $msg;
    if (!$snip_capture_context->[0]) {
        print $msg_output $msg;
    }
}

sub snip_mtag {
    return snip_tag(@_);
    my $add = shift || '';
    if ( $add ) {
        $add = ' '.$add;
    }
    return ( "||--snip--||".$add );
}

sub snip_mtagf {
    my $format = shift;
    return snip_mtag ( sprintf ( $format, @_ ));
}

sub snip_ptag {
    my $add = shift || '';
    if ( $add ) {
        $add = ' '.$add;
    }
    return ( $double_bar."<-snap->".$double_bar.$add );
}

sub snip_ptagf {
    my $format = shift;
    return snip_ptag ( sprintf ( $format, @_ ));
}

sub snip_tag {
    my $add = shift || '';
    if ( $add ) {
        $add = ' '.$add;
    }
    return ( $double_bar."<-snip->".$double_bar.$add );
}

sub snip_tagf {
    my $format = shift;
    return snip_tag ( sprintf ( $format, @_ ));
}
sub snip_tag_start {
    my $add = shift;
    if ( $add ) {
        $add = ' '.$add;
    }
    return snip_comment
        ( snip_tagf
          ( "%s %s%s\n",
            'start',
            strftime( "%Y-%m-%d %H:%M:%S", localtime ( time())),
            $add ));
}

sub snip_tag_stop {
    return snip_comment ( snip_tagf ( "%s\n", 'stop' ));
}

sub snip_tag_include {
    my $file = shift || '';
    return snip_comment ( snip_ptagf ( "%s %s\n", 'include', $file ));
}

sub snip_escape {
    local ( $_ ) = shift;
    s,^(($comment_start_skip_rx) *|)($double_bar_rx[|<])(\\*)([-:]snip[-:][>|]($double_bar_rx)[ \t\r]*(start|stop)([ \t\r]|$)),$1$3\\$4$5,mog;
    return $_;
}

sub snip_unescape {
    local ( $_ ) = shift;
    s,^(($comment_start_skip_rx) *|)($double_bar_rx[|<])\\(\\*)([-:]snip[-:][>|]($double_bar_rx)[ \t\r]*(start|stop)([ \t\r]|$)),$1$3$4$5,mog;
    return $_;
}

# |||:sec:||| string replacements
my $snip_replace_cache_rx = '';
my $snip_replace_cache_last_rx = '';
sub snip_is_replacement_defined {
    my $key = shift;
    return exists ( $SNIPS_REPLACEMENTS->{$key} );
}

sub snip_get_replacement {
    my $key = shift;
    my $default = shift;
    my $val;
    if ( snip_is_replacement_defined($key)) {
        $val = $SNIPS_REPLACEMENTS->{$key};
    } else {
        $val = $default;
    }
    return $val;
}

sub snip_set_replacement {
    my $key = shift;
    my $val = shift;
    my $no_overwrite = shift;
    if ( !$no_overwrite || !snip_is_replacement_defined($key)) {
        if ( defined($val) && $key eq $val ) {
            # no recursion!
            delete ( $SNIPS_REPLACEMENTS->{$key} );
        } else {
            $SNIPS_REPLACEMENTS->{$key} = $val;
        }
    }
    $snip_replace_cache_rx = '';
    return;
}

sub snip_del_replacement {
    my $key = shift;
    delete ( $SNIPS_REPLACEMENTS->{$key} );
    $snip_replace_cache_rx = '';
}

sub snip_set_user_replacement {
    my $key = shift;
    my $val = shift;
    my $no_overwrite = shift;
    if ( !$no_overwrite || !snip_is_replacement_defined($key)) {
        if ( $key eq $val ) {
            # no recursion!
            delete ( $SNIPS_REPLACEMENTS_USER->{$key} );
        } else {
            $SNIPS_REPLACEMENTS_USER->{$key} = $val;
        }
    }
    snip_set_replacement($key, $val, $no_overwrite);
    return;
}

sub snip_normalize_at_key {
    my $nkey = shift;
    $nkey =~ s,^\@,,so;
    $nkey =~ s,\@$,,so;
    return ( '@'.$nkey.'@', $nkey );
}

sub snip_is_at_replacement_defined {
    my $key = shift;
    return snip_is_replacement_defined ( '@'.$key.'@', @_ );
}

sub snip_get_at_replacement {
    my $key = shift;
    return snip_get_replacement ( '@'.$key.'@', @_ );
}

sub snip_set_at_replacement {
    my $key = shift;
    return snip_set_replacement ( '@'.$key.'@', @_ );
}

sub snip_del_at_replacement {
    my $key = shift;
    snip_del_replacement('@'.$key.'@');
}

sub snip_set_user_at_replacement {
    my $key = shift;
    return snip_set_user_replacement ( '@'.$key.'@', @_ );
}

sub snip_replacements_dump {
    my $replacements = shift || $SNIPS_REPLACEMENTS;
    my $replacements_rx = shift;
    if ( !defined ( $replacements_rx )) {
        $replacements_rx = snip_replace_rx();
    }
    if ($replacements_rx) {
        snip_msg ( " :RPX:  %-*s: [%s]\n", $dbg_fwid || 15, 'snip_replace_rx',
                   snip_fmt_rx ( $replacements_rx ));
    }
    foreach my $key (sort {
        my $r = lc($a) cmp lc($b);
        if ($r == 0) {
            $r = $a cmp $b;
        }
        ;
        $r;
    } (keys ( %{$replacements} ))) {
        my $value = $replacements->{$key};
        snip_msg ( " :RPD:  %-*s: [%s]\n", $dbg_fwid || 15, $key,
                   dbg_flatten_str(defined($value) ? $value : '<<<undef>>>'));
    }
}

sub snip_replace_rx_invalidate {
    $snip_replace_cache_rx = '';
    return;
}

sub snip_replace_rx {
    if ( !$snip_replace_cache_rx ) {
        $snip_replace_cache_rx =
            ( '('
              .join ( '|',
                      map {
                          s,([^0-9A-Za-z]),\\$1,sog;
                          $_;
                      } sort(keys ( %{$SNIPS_REPLACEMENTS} )))
              .')' );
        if ($snip_replace_cache_rx ne $snip_replace_cache_last_rx) {
            $snip_replace_cache_last_rx = $snip_replace_cache_rx;
            snip_replacements_dump($SNIPS_REPLACEMENTS, $snip_replace_cache_rx)
                if $DEBUG > 4;
        }
    }
    return $snip_replace_cache_rx;
}

sub snip_fmt_rx {
    local ( $_ ) = shift;
    my $indent = shift || ( $dbg_fwid || 15 ) + 3 + 8;
    my $istr = sprintf ( "%-*s", $indent,'' );
    my $fmt = '';
    while ( length ( $_ ) > 60 ) {
        my $pre = substr ( $_, 0, 60 );
        $_ = substr ( $_, 60 );
        if ( $pre =~ m/[|][^|]+$/so ) {
            $_ = $&.$_;
            $pre = substr ( $pre, 0, 60 - length ( $& ));
        }
        $fmt .= $pre."\n".$istr;
    }
    return $fmt.$_
}

my $snip_symbol_rx = '[:a-zA-Z_][-0-9a-zA-Z_]*';

sub snip_replace_quoted_no_warn {
    local ( $_ ) = shift;
    if ( m/(\@)\|(\|*$snip_symbol_rx\@)/so ) {
        my $pre = $`;
        my $unquoted = $1.$2;
        my $post = $';
        return $pre.$unquoted.snip_replace_quoted_no_warn($post);
    }
    return $_;
}

sub snip_replace_quoted {
    local $SIG{__WARN__} = sub {};
    return snip_replace_quoted_no_warn(@_);
}

sub snip_replace__ {
    local ( $_ ) = shift;
    my $snip_replace_rx = snip_replace_rx();
    my $res = '';
    # do not add `o` to match options!
    while ( m/$snip_replace_rx/s ) {
        # |:todo:| watch out for recursion
        my $key = $1;
        my $rpl = snip_get_replacement($key);
        if ( !defined ( $rpl )) {
            snip_msg ( "warning: undefined replacement [%s]\n", $1 || '' )
                if $DEBUG;
            snip_replacements_dump($SNIPS_REPLACEMENTS, $snip_replace_rx);
            $res .= $`.$key;
            $_ = $';
            next;
        }
        $_ = $`.$rpl.$';
        snip_msg ( " :RPS:  %-*s => [%s]\n",
                   ( $dbg_fwid || 15) - 2,
                   $1, dbg_flatten_str($SNIPS_REPLACEMENTS->{$1})) if $DEBUG > 6;
    }
    return $res.$_;
}

sub snip_replace_no_warn {
    local ( $_ ) = shift;
    if ( m/\@\|+($snip_symbol_rx)\@/so ) {
        my $pre = $`;
        my $quoted = $&;
        my $post = $';
        return snip_replace_no_warn($pre).$quoted.snip_replace_no_warn($post);
    }
    return snip_replace__($_);
}

sub snip_replace {
    local $SIG{__WARN__} = sub {};
    return snip_replace_no_warn(@_);
}

sub snip_is_replacement_final_defined {
    my $key = shift;
    return exists ( $SNIPS_REPLACEMENTS_FINAL->{$key} );
}

sub snip_is_at_replacement_final_defined {
    my $key = shift;
    return snip_is_replacement_final_defined ( '@'.$key.'@', @_ );
}

sub snip_get_replacement_final {
    my $key = shift;
    my $default = shift;
    my $val;
    if ( exists ( $SNIPS_REPLACEMENTS_FINAL->{$key} )) {
        $val = $SNIPS_REPLACEMENTS_FINAL->{$key};
    } else {
        $val = $default;
    }
    return $val;
}

sub snip_set_replacement_final {
    my $key = shift;
    my $val = shift;
    my $no_overwrite = shift;
    if ( !$no_overwrite || !exists($SNIPS_REPLACEMENTS_FINAL->{$key})) {
        if ( $key eq $val ) {
            delete ( $SNIPS_REPLACEMENTS_FINAL->{$key} );
        } else {
            $SNIPS_REPLACEMENTS_FINAL->{$key} = $val;
        }
    }
    return;
}

sub snip_get_at_replacement_final {
    my $key = shift;
    return snip_get_replacement_final ( '@'.$key.'@', @_ );
}

sub snip_set_at_replacement_final {
    my $key = shift;
    return snip_set_replacement_final ( '@'.$key.'@', @_ );
}

sub snip_replacements_save {
    my $new_replacements = shift;
    my $sv_replacements = $SNIPS_REPLACEMENTS;
    if ( $new_replacements ) {
        snip_replace_rx_invalidate();
    } else {
        $new_replacements = $SNIPS_REPLACEMENTS;
    }
    $SNIPS_REPLACEMENTS = { %{$new_replacements} };
    return $sv_replacements;
}

sub snip_replacements_restore {
    my $sv_replacements = shift;
    my $old_replacements = $SNIPS_REPLACEMENTS;
    $SNIPS_REPLACEMENTS = $sv_replacements;
    snip_replace_rx_invalidate();
    return $old_replacements;
}

sub snip_replace_final {
    local ( $_ ) = shift;
    if ( !$opt_no_final) {
        my $sv_replacements = snip_replacements_save
            ($SNIPS_REPLACEMENTS_FINAL);
        $_ = snip_replace_quoted(snip_replace($_));
        snip_replacements_restore($sv_replacements);
    }
    return $_;
}

sub snip_rpl_context_open {
    my $export = shift;
    my $import = shift;
    my $replacements = shift || {{}, {}, {}};
    my $replacements_nx = shift || {{}, {}};

    if ( !defined ( $export )) {
        $export = 1;
    }
    if ( !defined ( $import )) {
        $import = 1;
    }
    my $replacements_del = $replacements->[0];
    my $replacements_rst = $replacements->[1];
    my $replacements_add = $replacements->[2];

    my $replacements_nx_del = $replacements_nx->[0];
    my $replacements_nx_rst = $replacements_nx->[1];

    # replacements_add     set before include
    # replacements_del     delete after include
    # replacements_rst     restore after include
    # replacements_nx_del  delete after include
    # replacements_nx_rst  delete before include, restore after include

    # BEFORE INCLUDING
    #  export => current replacement dictionary is populated
    # !export => current replacement dictionary is empty
    #
    # - set replacements_add
    # - delete replacements_nx_rst
    #
    # AFTER INCLUDING
    # !import => just restore sv_replacements
    #  import =>
    #    - with include replacements still active
    #      - delete replacements_del
    #      - restore replacements_rst
    #      - delete replacements_nx_del
    #      - restore replacements_nx_rst
    #    - set replacements_import from snip_replacements_restore().
    #    - set replacements from replacements_import

    my $replacements_add_use = {};

    foreach my $key (sort(keys(%{$replacements_add}))) {
        my $value = $replacements_add->{$key};
        if ( !$value ) {
            $value = '';
        } else {
            $value = snip_replace($value);
            $value = snip_replace_quoted($value);
        }
        $replacements_add_use->{$key} = $value;
    }
    $replacements_add = $replacements_add_use;
    $replacements = [ @{$replacements}];
    $replacements->[2] = $replacements_add;

    my $sv_replacements;
    if ( $export ) {
        $sv_replacements = snip_replacements_save();
    } else {
        $sv_replacements = snip_replacements_save({});
    }

    my $rpl_context = [$export, $import, $replacements, $replacements_nx, $sv_replacements];

    foreach my $key (sort(keys(%{$replacements_add}))) {
        my $value = $replacements_add->{$key};
        snip_set_at_replacement($key, $value);
        snip_msg ( " ".":RPI:  %-*s: [%s] => [%s]\n", $dbg_fwid || 15,
                   "temp set", $key || '', dbg_flatten_str($value))
            if $DEBUG > 4;
    }
    foreach my $key (sort(keys(%{$replacements_nx_rst}))) {
        snip_del_at_replacement($key);
        snip_msg ( " ".":RPI:  %-*s: [%s]\n", $dbg_fwid || 15,
                   "nrst del", $key || '' )
            if $DEBUG > 4;
    }
    #snip_replace_rx_invalidate(); # |:check:| should not be necessary

    return $rpl_context;
}

sub snip_rpl_context_open_from_options {
    my $options = shift;
    return snip_rpl_context_open
        (
         exists($options->{'export'}) ?
         $options->{'export'}->[1]->[0] : 1,
         exists($options->{'import'}) ?
         $options->{'import'}->[1]->[0] : 1,
         exists($options->{'#subst#'}) ?
         $options->{'#subst#'}->[1] : {{}, {}, {}},
         exists($options->{'#undef#'}) ?
         $options->{'#undef#'}->[1] : {{}, {}},
        );
}

sub snip_rpl_context_close {
    my $rpl_context = shift;;

    my $export = $rpl_context->[0];
    my $import = $rpl_context->[1];
    my $replacements = $rpl_context->[2];
    my $replacements_nx = $rpl_context->[3];
    my $sv_replacements = $rpl_context->[4];

    my $replacements_del = $replacements->[0];
    my $replacements_rst = $replacements->[1];
    my $replacements_add = $replacements->[2];

    my $replacements_nx_del = $replacements_nx->[0];
    my $replacements_nx_rst = $replacements_nx->[1];

    if ( !$import ) {
        snip_replacements_restore($sv_replacements);
        snip_msg ( " ".":RPI:  %-*s: [%s]\n", $dbg_fwid || 15,
                   "no import", '' || '' )
            if $DEBUG > 4;
    } else {
        # delete temporary replacements
        foreach my $key ( sort(keys(%{$replacements_del}))) {
            snip_del_at_replacement($key);
            snip_msg ( " ".":RPI:  %-*s: [%s]\n", $dbg_fwid || 15,
                       "temp del", $key || '' )
                if $DEBUG > 4;
        }
        # restore temporary replacements
        foreach my $key ( sort(keys(%{$replacements_rst}))) {
            my $value = $replacements_rst->{$key};
            snip_set_at_replacement($key, $value);
            snip_msg ( " ".":RPI:  %-*s: [%s] => [%s]\n", $dbg_fwid || 15,
                       "temp rst", $key || '', dbg_flatten_str($value))
                if $DEBUG > 4;
        }
        # delete noexport replacements
        foreach my $key ( sort(keys(%{$replacements_nx_del}))) {
            snip_del_at_replacement($key);
            snip_msg ( " ".":RPI:  %-*s: [%s]\n", $dbg_fwid || 15,
                       "nexp del", $key || '' )
                if $DEBUG > 4;
        }
        # restore noexport replacements
        foreach my $key ( sort(keys(%{$replacements_nx_rst}))) {
            my $value = $replacements_nx_rst->{$key};
            snip_set_at_replacement($key, $value);
            snip_msg ( " ".":RPI:  %-*s: [%s] => [%s]\n", $dbg_fwid || 15,
                       "nexp rst", $key || '', dbg_flatten_str($value))
                if $DEBUG > 4;
        }
        # import new settings into old replacements
        my $replacements_import =
            snip_replacements_restore($sv_replacements);
        foreach my $key ( sort(keys(%{$replacements_import}))) {
            my @nkeys = snip_normalize_at_key($key);
            my $akey = $nkeys[0];
            my $nkey = $nkeys[1];
            my $value = $replacements_import->{$akey};
            my $prev_known = snip_is_at_replacement_defined($nkey);
            my $prev_value = snip_get_at_replacement($nkey);
            snip_set_at_replacement($nkey, $value);
            if ( !$prev_known || ( $prev_value || '' ) ne ( $value || '' )) {
                snip_msg ( " ".":RPI:  %-*s: [%s] => [%s]\n", $dbg_fwid || 15,
                           sprintf("<imp%s", $prev_known ? ' mod' : ' new'),
                           $akey || '', dbg_flatten_str($value || '<<<undef>>>'))
                    if $DEBUG > 4;
            }
        }
    }
    #snip_replace_rx_invalidate(); # |:check:| should not be necessary

    return;
}

# |||:sec:||| configuration and setup
sub snip_handle_shortcut {
    my $sc = shift;
    my $opt_only = shift;
    # :shortcut:
    if ( $prog_name eq 'snh' ) {
        if ( !$opt_only ) {
            usage( *STDOUT );
            exit ( 0 );
        }
    } elsif ( $sc eq 'snl' ) {
        $opt_list = 1;
        $cmd_seen = 1;
        $opt_name_rx = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snl --list' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'sng' ) {
        $opt_grep = 1;
        $cmd_seen = 1;
        @opt_grep_opts = @ARGV if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snl --list' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'sni' ) {
        $opt_list = 1;
        $cmd_seen = 1;
        $opt_as_includes = 1;
        $opt_name_rx = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'sni --as-includes --list' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'snc' ) {
        $opt_cat = 1;
        $cmd_seen = 1;
        $opt_name_rx = shift ( @ARGV ) if !$opt_only;
        $opt_temp_snippet = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snc --cat' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'snr' ) {
        $opt_cat = 1;
        if ( !$opt_no_replace_seen ) {
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
        }
        if ( !$opt_no_process_seen ) {
            $opt_process = 1;
            $opt_process_seen = 1;
            $opt_no_process_seen = 0;
        }
        $cmd_seen = 1;
        $opt_name_rx = shift ( @ARGV ) if !$opt_only;
        $opt_temp_snippet = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snr --replace --process --cat' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'snn' ) {
        $opt_new = 1;
        if ( !$opt_no_replace_seen ) {
            $opt_replace = 1;
            $opt_replace_seen = 1;
            $opt_no_replace_seen = 0;
        }
        if ( !$opt_no_process_seen ) {
            $opt_process = 1;
            $opt_process_seen = 1;
            $opt_no_process_seen = 0;
        }
        $cmd_seen = 1;
        $opt_filename = shift ( @ARGV ) if !$opt_only;
        $opt_name = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snn --replace --process --new' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'sna' ) {
        $opt_append = 1;
        $cmd_seen = 1;
        $opt_name = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'sna --append' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'sns' ) {
        $opt_store = 1;
        $cmd_seen = 1;
        $opt_name = shift ( @ARGV ) if !$opt_only;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'sns --stor' || '' ) if $DEBUG > 4;
    } elsif ( $sc eq 'snw' ) {
        $opt_work = 1;
        $cmd_seen = 1;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "cmd_seen", 'snw --work' || '' ) if $DEBUG > 4;
    }
    return;
}

sub snip_consolidate_modes {
    foreach my $mode ( keys ( %{$SNIPS_MODES} )) {
        my $mode_defs = $SNIPS_MODES->{$mode};
        my $mode_cat_defs = $mode_defs->[ $snm_indx_cat ];
        if ( !ref ( $mode_cat_defs )) {
            $mode_cat_defs = [ $mode_cat_defs ];
            $mode_defs->[ $snm_indx_cat ] = $mode_cat_defs;
        }

        my $comment_defs = $mode_defs->[ $snm_indx_comm ];
        if ( !ref ( $comment_defs )) {
            $comment_defs = [ $comment_defs ];
            $mode_defs->[ $snm_indx_comm ] = $comment_defs;
        }

        my $comment_start = $comment_defs->[ 0 ];
        my $comment_start_skip = $comment_defs->[ 1 ];
        my $comment_end = $comment_defs->[ 2 ];
        if ( !$comment_start_skip ) {
            $comment_start_skip = $comment_start;
            $comment_start_skip =~ s,([^0-9A-Za-z]),\\$1,sog;
            $comment_start_skip .= ( length ( $comment_start ) == 1 ? '+' : '');
            $comment_defs->[ 1 ] = $comment_start_skip;
        }
        if ( !$comment_end ) {
            $comment_defs->[ 2 ] = '';
        } else {
            my $comment_end_skip = $comment_defs->[ 3 ];
            if ( !$comment_end_skip ) {
                $comment_end_skip = $comment_end;
                $comment_end_skip =~ s,([^0-9A-Za-z]),\\$1,sog;
                $comment_defs->[ 3 ] = $comment_end_skip;
            }
        }

        my $new_snippet = $mode_defs->[ $snm_indx_new ];
        if ( !$new_snippet ) {
            $mode_defs->[ $snm_indx_new ] = $mode_cat_defs->[ 0 ].'_new';
        }
    }
}

sub snip_default_mode {
    my $mode = shift || $SNIPS_MODE || $SNIPS_CAT || $SNIPS_DEF_MODE;
    if ( !exists ( $SNIPS_MODES->{$mode} )) {
        snip_add_mode ( $mode => [ $SNIPS_DEF_MODE,
                                   [ $mode,
                                     $SNIPS_CAT
                                     || $SNIPS_MODES->{$SNIPS_DEF_MODE}->[ $snm_indx_cat ]->[ 0 ],
                                   ],
                                   $SNIPS_MODES->{$SNIPS_DEF_MODE}->[ $snm_indx_comm ],
                                   $SNIPS_MODES->{$SNIPS_DEF_MODE}->[ $snm_indx_hf ],
                                 ]);
        $SNIPS_MODES->{$mode}->[ $snm_indx_new ] =
            $SNIPS_MODES->{$mode}->[ $snm_indx_cat ]->[ 0 ].'_new';
    }
    return $mode;
}

sub snip_add_mode {
    my $mode = shift;
    my $def = shift;
    my $set_emacs_mode = shift;
    my $new_snippet = shift;
    if ( ref ( $mode )) {
        $def = $mode;
        $mode = $def->[ $snm_indx_mode ];
    } elsif ( !ref ( $def )) {
        snip_default_mode ( $def );
        $def = [ @{$SNIPS_MODES->{$def}} ];
    }
    if ( $set_emacs_mode ) {
        snip_msg ( " ".":DBG: %-*s: [%s]\n", $dbg_fwid || 15, "set emacs mode", $mode || '' )
            if $DEBUG > 5;
        $def->[ $snm_indx_mode ] = $mode;
    }
    if ( $new_snippet ) {
        $def->[ $snm_indx_new ] = $new_snippet;
    }
    $SNIPS_MODES->{$mode} = $def;
    return $def;
}

sub snip_setup_comments {
    if ( $SNIPS_COMMENT_START && !$SNIPS_COMMENT_START_SKIP ) {
        die "SNIPS_COMMENT_START_SKIP missing";
    }
    if ( $SNIPS_COMMENT_END && !$SNIPS_COMMENT_END_SKIP ) {
        die "SNIPS_COMMENT_END_SKIP missing";
    }
    if ( !$SNIPS_COMMENT_START_SEP ) {
        $SNIPS_COMMENT_START_SEP = $SNIPS_COMMENT_START ? $SNIPS_COMMENT_START.' ' : '';
    }
    if ( !$SNIPS_COMMENT_END_SEP ) {
        $SNIPS_COMMENT_END_SEP = $SNIPS_COMMENT_END ? ' '.$SNIPS_COMMENT_END : '';
    }
    snip_set_at_replacement ( 'comm',  $SNIPS_COMMENT_START );
    snip_set_at_replacement ( 'comme', $SNIPS_COMMENT_END );
    snip_set_at_replacement ( 'comm_', $SNIPS_COMMENT_START_SEP );
    snip_set_at_replacement ( '_comm', $SNIPS_COMMENT_END_SEP );

    #  |:info:| new comment syntax
    snip_set_at_replacement ( ':comm',  $SNIPS_COMMENT_START );
    snip_set_at_replacement ( ':comme', $SNIPS_COMMENT_END );
    snip_set_at_replacement ( ':comm_', $SNIPS_COMMENT_START_SEP );
    snip_set_at_replacement ( ':_comm', $SNIPS_COMMENT_END_SEP );
    # block line comment
    if ( $SNIPS_COMMENT_END ) {
        snip_set_at_replacement ( 'bcomm', '@:comm@' );
        snip_set_at_replacement ( 'bcomme', '@:comme@' );
        snip_set_at_replacement ( 'bcomm_', '@:comm@'."\n".'@:lcomm_@' );
        snip_set_at_replacement ( '_bcomm', "\n".'@:comme@' );
        snip_set_at_replacement ( 'lcomm', '' );
        snip_set_at_replacement ( 'lcomm_', '' );

        # |:info:| new comment syntax
        snip_set_at_replacement ( ':bcomm', '@:comm@' );
        snip_set_at_replacement ( ':bcomme', '@:comme@' );
        snip_set_at_replacement ( ':bcomm_', '@:comm@'."\n".'@:lcomm_@' );
        snip_set_at_replacement ( ':_bcomm', "\n".'@:comme@' );
        snip_set_at_replacement ( ':lcomm', '' );
        snip_set_at_replacement ( ':lcomm_', '' );
    } else {
        snip_set_at_replacement ( 'bcomm', '@:lcomm@' );
        snip_set_at_replacement ( 'bcomme', '@:comme@' );
        snip_set_at_replacement ( 'bcomm_', '@:lcomm_@');
        snip_set_at_replacement ( '_bcomm', '@:_comm@' );
        snip_set_at_replacement ( 'lcomm', '@:comm@' );
        snip_set_at_replacement ( 'lcomm_', '@:comm_@' );

        # |:info:| new comment syntax
        snip_set_at_replacement ( ':bcomm', '@:lcomm@' );
        snip_set_at_replacement ( ':bcomme', '@:comme@' );
        snip_set_at_replacement ( ':bcomm_', '@:lcomm_@');
        snip_set_at_replacement ( ':_bcomm', '@:_comm@' );
        snip_set_at_replacement ( ':lcomm', '@:comm@' );
        snip_set_at_replacement ( ':lcomm_', '@:comm_@' );
    }
}

my $DEBUG_CMC = 50;
my $DEBUG_CMC1 = 50;
my $DEBUG_CMC2 = 50;

my $protection = 0;

sub snip_split_lines {
    local($_) = shift || '';
    my $lines = [split(/\n/, $_."@")];
    my $last = pop(@{$lines});
    push(@{$lines}, substr($last, 0, -1));
    return $lines;
}

package Snippet;                  # |:here:|

use vars qw(@ISA);

@ISA = ('Line');

# new(TEXT, LINENO)
sub new {
    # First parameter is a class name or blessed hash ref
    my $class = shift;

    if ( ref( $class ) ne '' ) {
        $class = ref( $class );
        # MyBaseClass::new($self, @_ );
        #
    }

    my $self =
        {
         'type' => undef,
        };

    # use my own methods, not the parent's
    bless $self;

    self->init( @_ );

    bless $self, $class;
    return $self;
}

sub __iter__ {
    my $self = shift;
    $self->{'indx'} = 0;
    return $self;
}

sub next {
    my $self = shift;
    my $indx = $self->{'indx'};
    my $snippets = $self->{'snippets'};
    if ($indx >= scalar(@{$snippets} )) {
        return undef;
    }
    $self->{'indx'} += 1;
    return $snippets->[$indx];
}

# text, lineno
sub init {
    my $self = shift;
    my $text = shift;
    my $lineno = shift;
    $self->setText($text);
    $self->setLineNo($lineno);
    $self->{'lines'} = [];
    $self->{'snippets'} = [];
    $self->{'indx'} = 0;
}

# lineno
sub setLineNo {
    my $self = shift;
    my $lineno = shift || 0;
    $self->{'lineno'} = $lineno;
}

# text
sub setText {
    my $self = shift;
    my $text = shift || '';
    $self->{'text'} = $text;
    return $self;
}

# ()
sub split {
    my $self = shift;
    my $text = $self->{'text'};
    my $lines = $self->{'lines'} = snip_split_lines($text);
    return $lines;
}

#   SNIPPET = append ()
sub append {
    my $self = shift;
    my $snippet = shift;
    if ( !defined ( $snippet )) {
        $snippet = new Snippet();
    }
    push(@{$self->{'snippets'}}, $snippet);
    return $snippet;
}

sub dumpSnippets {
    my $self = shift;
    my $it = $self->__iter__();
    my $snippet;
    while (defined($snippet = $it->next())) {
        $snippet->dump();
    }
    return;
}

sub dump {
    my $self = shift;
    my $indx = 0;
    foreach my $line (@{$self->{'lines'}}) {
        snip_msg( " ".":CHK:  %-*s: [%s]\n", $dbg_fwid || 15, sprintf("line %3d", $indx), $line || '');
    }
    $self->dumpSnippets();
}

package SnippetChunkers;                  # |:here:|

use vars qw(@ISA);

@ISA = ('Snippet');

package SnippetContext;                  # |:here:|

use vars qw(@ISA);

@ISA = ('Snippet');

# new SnippetContext( TEXT, MODE, CHUNKERS, MODES )
sub new {
    # First parameter is a class name or blessed hash ref
    my $class = shift;
    if ( ref( $class ) ne '' ) {
        $class = ref( $class );
    }

    my $text = shift;
    my $self;
    $self = new Snippet(undef, $text);
    bless $self;

    my $mode = shift || 'generic';
    my $chunkers = shift || [];
    my $modes = shift || {'generic' => []};

    $self->{'mode'} = $mode;
    $self->{'chunkers'} = $chunkers,
    $self->{'modes'} = $modes;
    $self->{'cindx'} = 0;

    my $cdict = {};
    foreach my $chunker (@{$chunkers}) {
        $cdict->{$chunker->[0]} = $chunker;
    }

    $self->{'cdict'} = $cdict;

    #  |:todo:| init
    bless $self, $class;
    return $self;
}

# snip_it(TEXT|BLOCK)
sub snip_it {
    my $self = shift;
    # chunkers, snippetder_indx ...

    my $text = $_[0];

    if ( !defined ( $self )) {
        $self = new SnippetContext(undef, @_);
    } else {
        $self->{'block'}->{'text'} = $text;
    }
    $self->{'text'} =  $self->{'block'}->{'text'};
    my $indx;
    while (1) {
        my $cindx = $self->{'cindx'}++;
        my $chunkers = $self->{'chunkers'};
        if ($cindx >= scalar(@{$chunkers})) {
            last;
        }
        while ( 1 ) {
            my $chunker = $chunkers->[$cindx]; # may be volatile!
            my $result = &{$chunker->[1]}
                (
                 $chunker,
                 $self,         # fixed
                 $cindx,        # fixed
                 $self->{'chunkers'}); # may be, but should not be volatile
            $self->{'result'} = $result;
            if ( $result < 0 ) {
                return $self;
            }
            if ( $result > 0 ) {
                last;
            }
        }
    }
    return $self;
}

package main;                   # |:here:|

# |:here:|
my $snip_chunkers =
    [
     [ 'name',  \&snip_chunker_block_comments, 'data' ],
    ];

# |:here:|
sub snip_chunker_block_comments {
    my $self = shift;
    my $context = shift;
    my $cindx = shift;
    my $chunkers = shift;

    my $block = $context->{'block'};
    local ( $_ ) = $context->{'text'};

    my $css_in = $self->[2] || $SNIPS_COMMENT_START_SKIP;
    my $ces_in = $self->[3] || $SNIPS_COMMENT_END_SKIP;
    my $comment_syntax = $self->[4] || $context->{'mode'}->[$snm_indx_comm];

    my $converted = '';

    # Setup Comment syntax.

    my $gen_ss = '\@:[b]?comm_?\@';
    my $gen_es = '\@:(_b?comm|b?comme)\@';
    my $gen_ls = '\@:lcomm\@';

    # we may  be dealing with partial comments  here, so determine
    # the first block comment start or end.

    my $in_comment = 0;
    my $have_comm = 0;

    my $snippets = [];
    $block->{'snippets'} = $snippets;

    # |:here:|
    #  something */ with more text
    #  */
    #  something /* with more text
    #  something /* with more text */ and still more ...

    if (m/($gen_ss)|$gen_es/so) {
        my $snippet;
        $snippet = new Snippet();

        $have_comm = 1;
        $block->{'have_comm'} = $have_comm;

        # comment end found before comment start
        $in_comment = !defined( $1 );
        $block->{'in_comment'} = $in_comment;

        $snippet->{'is_comment'} = $in_comment;

        my $part = $`;
        my $css = $&;
        local( $_ ) = $';

        $snippet->{'text'} = $part;

        my $indents = '';
        my $indent = 0;

        # determine indent
        if ($part =~ s,(\n)([^\n]*)$,,sog) {
            $indents = $2;
            $part = $`.$1;
            $indent = length($indents);
        }

        $snippet->{'indent'} = $indent;
        my  $lines = snip_split_lines($part);
        $snippet->{'lines'} = $lines;

        $indents =~ s/([ \t\r]+)$//sog;
        if ($indents) {
            push(@{$lines},$indents);
        }

    }

    return 1;

    my $in_block = 0;

    # - convert everything to line blocks
    # - keeping indendation of the block comment starter
    #   or the block comment ender for partial comments.

    while ($have_comm) {
        if (!$in_block) {
            if (m/$gen_ss/so) {
                my $part = $`;
                my $css = $&;
                $_ = $';

                if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 ) {
                    printf STDERR ( "%s\n", '--------------------' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "gen_ss", $gen_ss || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "css", $css || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
                }
                # make all line comments block comments
                $part =~ s,$gen_ls([^\n]*),'@:comm@'.($1||'').'@:comme@',esog;
                $converted .= $part.$css;
                $in_block = 1;
            } else {
                # non-block trailer
                last;
            }
        }
        if ($in_block) {
            if (m/$gen_es/so) {
                my $part = $`;
                my $ces = $&;
                $_ = $';

                # remove all stray comment starters in block range
                $part =~ s,$gen_ss,,sog;

                if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 ) {
                    printf STDERR ( "%s\n", '--------------------' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "gen_es", $gen_es || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "ces", $ces || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
                }

                # remove all line comments in block range
                $part =~ s,$gen_ls,,sog;
                $converted .= $part.$ces;
                $in_block = 0;
            } else {
                # unterminated comment
                snip_msg ( " ".":CMC:  unterminated block comment")
                    if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 );
                last;
            }
        }
    }

    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
               "conv: cleanup done", dbg_flatten_str($_) || '' )
        if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 );

    return $converted . $_;
}

sub snip_cmc_generic_prepare {
    local ( $_ ) = shift;
    my $css_in = shift || $SNIPS_COMMENT_START_SKIP;
    my $ces_in = shift || $SNIPS_COMMENT_END_SKIP;
    my $converted = '';

    # special preparations for generic comments
    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
               "conv: cleanup setup", dbg_flatten_str($_) || '' )
        if $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1;
    if ( $protection > 5 ) {
        die 'endless loop!';
    }
    $protection += 1;
    $converted = '';

    my $gen_compat = '@:?(_?[bl]?comm(_|e)?)@';
    s,$gen_compat,\@:$1\@,sog;

    my $gen_spc_stl = '\@:lcomm_\@';
    s,$gen_spc_stl,\@:lcomm\@ ,sog;

    my $gen_ss = '\@:[b]?comm_?\@';
    my $gen_es = '\@:(_b?comm|b?comme)\@';
    my $gen_ls = '\@:lcomm\@';

    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
               "conv: cleanup prep done", dbg_flatten_str($_) || '' )
        if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 );

    # we may  be dealing with partial comments  here, so determine
    # the first block comment start or end.

    if (m/($gen_ss)|$gen_es/so) {
        my $in_block = !defined( $1 );
        while (1) {
            if (!$in_block) {
                if (m/$gen_ss/so) {
                    my $part = $`;
                    my $css = $&;
                    $_ = $';

                    if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 ) {
                        printf STDERR ( "%s\n", '--------------------' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "gen_ss", $gen_ss || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "css", $css || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
                    }
                    # make all line comments block comments
                    $part =~ s,$gen_ls([^\n]*),'@:comm@'.($1||'').'@:comme@',esog;
                    $converted .= $part.$css;
                    $in_block = 1;
                } else {
                    # non-block trailer
                    last;
                }
            }
            if ($in_block) {
                if (m/$gen_es/so) {
                    my $part = $`;
                    my $ces = $&;
                    $_ = $';

                    # remove all stray comment starters in block range
                    $part =~ s,$gen_ss,,sog;

                    if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 ) {
                        printf STDERR ( "%s\n", '--------------------' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "gen_es", $gen_es || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "ces", $ces || '' );
                        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
                    }

                    # remove all line comments in block range
                    $part =~ s,$gen_ls,,sog;
                    $converted .= $part.$ces;
                    $in_block = 0;
                } else {
                    # unterminated comment
                    snip_msg ( " ".":CMC:  unterminated block comment")
                        if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 );
                    last;
                }
            }
        }
    }
    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
               "conv: cleanup done", dbg_flatten_str($_) || '' )
        if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 );

    return $converted . $_;
}

sub snip_cmc_generic_replace {
    local ( $_ ) = shift;

    # convert generic comments to current mode
    my $gen_rpl = {};
    my $gen_comms =
        [
         ':comm',
         ':comme',
         ':comm_',
         ':_comm',
         ':bcomm',
         ':bcomme',
         ':bcomm_',
         ':_bcomm',
         ':lcomm',
         ':lcomm_',
        ];
    foreach my $gen_comm (@{$gen_comms}) {
        my $rpl = snip_get_at_replacement($gen_comm, undef);
        if ( defined ( $rpl )) {
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
                       sprintf("rpl %s", $gen_comm), $rpl || '' )
                if $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1;
            $gen_rpl->{$gen_comm} = $rpl;
        } else {
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
                       sprintf("rpl %s", $gen_comm), '<<<undef>>>' || '' )
                if $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1;
        }
    }
    my $sv_replacements = snip_replacements_save();
    foreach my $gen_comm (keys(%{$gen_rpl})) {
        snip_set_at_replacement($gen_comm, $gen_rpl->{$gen_comm});
    }
    $_ = snip_replace($_);
    snip_replacements_restore($sv_replacements);

    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15,
               "conv: replacement done", dbg_flatten_str($_) || '' )
        if $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1;

    return $_;
}

sub snip_cmc_normalize_block {
    local ( $_ ) = shift;
    my $css_in = shift || $SNIPS_COMMENT_START_SKIP;
    my $ces_in = shift || $SNIPS_COMMENT_END_SKIP;

    my $converted = '';
    my $comment_ws = "( |[ \t\r]*\n|)";
    my $css = $css_in.$comment_ws;
    my $ces = $comment_ws.$ces_in;
    while ( m/$css/s ) {
        my $part = $`;
        $converted .= $part;
        my $cs = $&;
        $_ = $';

        if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC2 ) {
            printf STDERR ( "%s\n", '--------------------' );
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "css", $css || '' );
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "cs", $cs || '' );
            snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
        }

        my $com = '';
        my $ce = '';
        while ( 1 ) {
            if (m/$ces/s) {
                my $part = $`;
                $com .= $part;
                $ce = $&;
                $_ = $';

                if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC2 ) {
                    printf STDERR ( "%s\n", '--------------------' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "ces", $ces || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "converted", $converted || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "part", dbg_flatten_str($part) || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "ce", $ce || '' );
                    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "rest", dbg_flatten_str($_) || '' );
                }
            } else {
                last;
            }
            if (m/^[ \t\r]*(\n[ \t\r]*)($css)/s) {
                my $sep_ws = $1;
                #snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "sep_ws", $sep_ws || '' );
                $com .= $1;
                $_ = $';
                next;
            }
            last;
        }
        $com =~ s,\n(([ \t]* )|)([^ \t\n]),"\n".( defined($2) ? $2.'@:lcomm_@' : '@:lcomm_@' ).$3,seog;
        my $bs;
        my $be;
        if ($com =~ m/\n/ ) {
            $bs = ($cs =~ m/( |\n)$/ ) ? '@:bcomm_@' : '@:bcomm@';
            $be = ($ce =~ m/^( |\n)/ ) ? '@:_bcomm@' : '@:bcomme@';
        } else {
            $bs = ($cs =~ m/( |\n)$/ ) ? '@:comm_@' : '@:comm@';
            $be = ($ce =~ m/^( |\n)/ ) ? '@:_comm@' : '@:comme@';
        }

        $converted .= $bs.$com.$be;
    }
    return $converted . $_;
}

sub snip_cmc_normalize_line {
    local ( $_ ) = shift;
    my $css_in = shift || $SNIPS_COMMENT_START_SKIP;
    my $ces_in = shift || $SNIPS_COMMENT_END_SKIP;

    my $converted = '';
    my $comment_ws = "( |[ \t\r]*\n|)";
    my $lss = $css_in;
    my $css = $css_in.$comment_ws;
    while (m/$css/s) {
        $converted .= $`;
        my $cs = $&;
        $_ = $';
        my $com = '';
        while (m/^([^\n]*[\n])/s) {
            $com .= ($1||'');
            $_ = $';
            if (m/^([ \t\r]*)$lss( |)/s) {
                $com .= ($1||'');
                $_ = $';
                next;
            }
            last;
        }
        if ( $com =~ m/\n$/ ) {
            $_ = $& . $_;
            $com = $`;
        }
        $com =~ s,\n(([ \t]* )|)([^ \t\n]),"\n".( defined($2) ? $2.'@:lcomm_@' : '@:lcomm_@' ).$3,seog;
        my $bs;
        my $be;
        if ($com =~ m/\n/ ) {
            $bs = ($cs =~ m/( |\n)$/ ) ? '@:bcomm_@' : '@:bcomm@';
            $be = ($cs =~ m/( |\n)$/ ) ? '@:_bcomm@' : '@:bcomme@';
        } else {
            $bs = ($cs =~ m/( |\n)$/ ) ? '@:comm_@' : '@:comm@';
            $be = ($cs =~ m/( |\n)$/ ) ? '@:_comm@' : '@:comme@';
        }
        $converted .= $bs.$com.$be;
    }
    return $converted . $_;

}

sub snip_convert_comments {
    local ( $_ ) = shift;
    my $css_in = shift || $SNIPS_COMMENT_START_SKIP;
    my $ces_in = shift || $SNIPS_COMMENT_END_SKIP;
    my $clean = shift || 0;

    my $converted = '';
    my $is_block = $css_in && $ces_in;
    my $is_line = $css_in;

    if ( $DEBUG > $DEBUG_CMC || $DEBUG > $DEBUG_CMC1 ) {
        snip_msg ( "%s\n", '--------------------------------------------------' );
        snip_msg ( " ".":CMC:  %-*s: [%d]\n", $dbg_fwid || 15, "CONV", $clean ? 2 : 1);
        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "css", $css_in || '' );
        snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "ces", $ces_in || '' );
    }

    if ( !$clean ) {

        $_ = snip_cmc_generic_prepare($_, $css_in, $ces_in );

        my $mode_spec = $SNIPS_MODES->{'generic'};
        my $comm_spec = $mode_spec->[$snm_indx_comm];

        # now, normalize for generic comments
        $_ = snip_cmc_normalize_block($_, $comm_spec->[1], $comm_spec->[3], 1);

        # Convert to current mode
        $_ = snip_cmc_generic_replace($_);

    }

    # |:sec:| Normal comment conversion
    if ( $is_block ) {
        $_ = snip_cmc_normalize_block($_, $css_in, $ces_in);
    } elsif ($is_line) {
        $_ = snip_cmc_normalize_line($_, $css_in, $ces_in);
    }
    return $_;
}

sub snip_cleanup_comments {
    local ( $_ ) = shift;
    if ( $SNIPS_COMMENT_START && $SNIPS_COMMENT_END ) {
        my $comment_span_rx = "([ \t\r]*($SNIPS_COMMENT_END_SKIP)[ \t\r\r]*)\n([ \t\r]*($SNIPS_COMMENT_START_SKIP))";
        while ( m,$comment_span_rx,s ) {
            my $elen = length ( $1 );
            my $slen = length ( $& ) - $elen - 1;
            $_ = $`.sprintf ( "\n%-*s", $slen, '' ).$';
        }
    }
    return $_;
}

sub check_snip_convert_comments {

    my $blk;
    my $lin;

    $blk = '
/* block comment */
/* block comment */
/* block comment */
   /* block comment */
   /* block comment */
   /* block comment */

/*
block comment
block comment
block comment
block comment
*/

/* block comment
     block comment
     block comment */

/* block comment */
/* block comment */

/* block comment */

/* block comment */
';

    my $sep = "-----\n";

    snip_set_mode('c');
    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_COMMENT_START_SKIP", $SNIPS_COMMENT_START_SKIP || '' );
    snip_msg ( " ".":CMC:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_COMMENT_END_SKIP", $SNIPS_COMMENT_END_SKIP || '' );

    my $conv = snip_convert_comments($blk);
    print $blk."\n";
    print $sep.$conv."\n";
    my $reconv = snip_replace($conv);
    print $sep.$reconv."\n";
    snip_set_mode('c++');
    my $cxx = snip_replace($conv);
    print $sep.$cxx."\n";
    snip_set_mode('el');
    my $el = snip_replace($conv);
    print $blk.$sep.$conv.$sep.$reconv.$sep.."\n";
    print $sep.$el."\n";

    $conv = snip_convert_comments($el);
    print $sep.$conv."\n";
    $reconv = snip_replace($conv);
    print $sep.$reconv."\n";
    snip_set_mode('c++');
    $cxx = snip_replace($conv);
    print $sep.$cxx."\n";
    snip_set_mode('c');
    my $c = snip_replace($conv);
    print $sep.$c."\n";

    snip_set_mode('generic');
    my $gen = snip_convert_comments($conv);
    print $sep.$gen."\n";

}

#check_snip_convert_comments(); exit(0); # |:debug:|

sub snip_set_mode {
    my $mode = shift;
    my $main_only = shift;

    if ( !exists ( $SNIPS_MODES->{$mode} )) {
        snip_default_mode ( $mode );
    }
    my $mode_settings = $SNIPS_MODES->{$mode};
    my $mode_categories = $mode_settings->[ $snm_indx_cat ];
    $SNIPS_CAT = $mode_categories->[ 0 ];
    if ($SNIPS_CAT_IS_DEFAULT) {
        $SNIPS_CAT_IS_DEFAULT = $SNIPS_MODE_IS_DEFAULT;
    }
    if ( !$opt_accept_cat_seen ) {
        if ( !$main_only  ) {
            $opt_accept_cat_rx = "^(".join( "|", @{$mode_categories} ).")\$";
        }
    }
    my $comment_defs = $mode_settings->[ $snm_indx_comm ];
    $SNIPS_COMMENT_START = $comment_defs->[ 0 ];
    $SNIPS_COMMENT_START_SKIP = $comment_defs->[ 1 ];
    $SNIPS_COMMENT_END = $comment_defs->[ 2 ];
    $SNIPS_COMMENT_END_SKIP = $comment_defs->[ 3 ];
    $SNIPS_COMMENT_START_SEP = $comment_defs->[ 4 ];
    $SNIPS_COMMENT_END_SEP = $comment_defs->[ 5 ];
    snip_setup_comments();

    snip_set_at_replacement ( 'mode', $mode_settings->[ $snm_indx_mode ]);
    snip_set_at_replacement ( 'snip_mode', $mode);

    snip_msg ( " ".":DBG:  %-*s: [%s] main-only: [%s]\n",
               $dbg_fwid || 15, "snip_set_mode",
               $mode || '', $main_only  ? 'y' : 'n' ) if $DEBUG > 1;
    return $mode_settings;
}

sub snip_set_default_mode {
    my $mode = snip_default_mode ( shift );
    snip_set_mode ( $mode );
    return $mode;
}

sub snip_part_for_mode {
    my $mode = snip_default_mode ( shift );
    my $part_name = shift;
    my $part_template = shift;
    my $part_mode_index = shift;
    my $part_default = shift;
    my $part_builtin = shift;
    my $part = '';
    my $mode_settings = $SNIPS_MODES->{$mode};
    my $mode_pfx = $mode_settings->[ $snm_indx_cat ]->[ 0 ];
    my $inc_files = snips_find_file ( 1, 0, '^'.$mode_pfx.'_t'.$part_template.'$' );
    my $inc_file = $inc_files->[ 0 ];
    # disable uuid handler in header
    my $uuid_handler = snip_tag_get_handler_copy('uuid', 0);
    # printf STDERR ( "# |".":DBG:| %-*s: [%s]\n", $dbg_fwid || 15, "uuid_handler", repr($uuid_handler) || '' );
    # printf STDERR ( "# |".":DBG:| %-*s: [%s]\n", $dbg_fwid || 15, "snip_tag_get_handlers", repr(snip_tag_get_handlers()) || '' );
    $uuid_handler = snip_tag_set_handler('uuid', $uuid_handler);
    # snippet ^<mode>_t<part>$
    if ( $inc_file ) {
        $part = snips_read_snippet( $inc_file, 1, 1, 1, 1 );
    }
    if ($part) {
        snip_msg ( " ".":HDR:  %-*s: [%s] found\n",
                   $dbg_fwid || 15, $part_name." (mode snippet)",
                   $inc_file ) if $DEBUG > 1;
    }
    if (!$part) {
        # snippet ^snip_t<part>$
        $inc_files = snips_find_file ( 1, 0, '^snip_t'.$part_template.'$' );
        $inc_file = $inc_files->[ 0 ];
        if ( $inc_file ) {
            $part = snips_read_snippet( $inc_file, 1, 1, 1, 1 );
        }
        if ( $part ) {
            snip_msg ( " ".":HDR:  %-*s: [%s] found\n",
                       $dbg_fwid || 15, $part_name." (snippet)",
                       $inc_file ) if $DEBUG > 1;
        }
    }
    if ( !$part ) {
        my $hf_defs = $mode_settings->[ $snm_indx_hf ];
        $part = $hf_defs->[ $part_mode_index ];
        if ( $part ) {
            # mode definition part
            snip_msg ( " ".":HDR:  %-*s: [%s] found\n",
                       $dbg_fwid || 15, $part_name." (mode definition)",
                       $mode_settings->[ $snm_indx_mode ]) if $DEBUG > 1;
        } elsif ( $part_default ) {
            $part = $part_default;
            snip_msg ( " ".":HDR:  %-*s: [%s] found\n",
                       $dbg_fwid || 15, $part_name,
                       'default') if $DEBUG > 1;
        } else {
            # built-in part
            $part = $part_builtin;
            snip_msg ( " ".":HDR:  %-*s: [%s] found\n",
                       $dbg_fwid || 15, $part_name,
                       'built-in') if $DEBUG > 1;
        }
        $part = snips_process_snippet( $part, '<builtin '.$part_name.'>', 1, 1, 1, 1 );
    }
    snip_tag_set_handler($uuid_handler);
    $part = snip_cleanup_comments($part);
    {
        local($opt_no_final) = 0;
        $part = snip_replace_final($part);
    }
    return $part;
}

my $SNIP_HEADER_BUILT_IN = <<'__EOS__';
@:comm_@-*- @mode@ -*-@:_comm@

@:comm_@||<-snap->|| default title @mode@ Snippet@:_comm@
@:comm_@||<-snap->|| title @title@@:_comm@
@:comm_@||<-snap->|| uuid @uuid@@:_comm@

__EOS__

my $SNIP_FOOTER_BUILT_IN = <<'__EOS__';
@:bcomm_@:ide-menu: Emacs IDE Main Menu - Buffer @BUFFER@
@:lcomm_@. M-x `eIDE-menu' ()(eIDE-menu "z")

@:lcomm_@:ide: SNIP: myself
@:lcomm_@. (snip-cat-mode (concat "" (buffer-file-name)) nil)@:_bcomm@@fempty@
@:bcomm_@
@:lcomm_@Local Variables:
@:lcomm_@mode: @mode@
@:lcomm_@mode: snip-minor
@:lcomm_@End:@:_bcomm@@fempty@
__EOS__

snip_set_at_replacement('snip_header', $SNIP_HEADER_BUILT_IN);
snip_set_at_replacement('snip_footer', $SNIP_FOOTER_BUILT_IN);

sub snip_header_for_mode {
    return snip_part_for_mode(shift, 'header', 'head', 0,
                              snip_get_at_replacement('snip_header'),
                              $SNIP_HEADER_BUILT_IN);
}

sub snip_footer_for_mode {
    return snip_part_for_mode(shift, 'footer', 'foot', 0,
                              snip_get_at_replacement('snip_footer'),
                              $SNIP_FOOTER_BUILT_IN);
}

# processing

my $snip_ignore_files_rx = '^([.#].*|.*(~|\.orig\|,v\|\.bak))$';        # |:todo:| make option
$snip_ignore_files_rx = '^$';

# VOID snips_collect_snippets ( snips-dir, ... )
sub snips_collect_snippets {
    my @snips_dirs = @_;
    local ( *SNIPSDIR );
    local ( $_ );
    # clear old snippets info
    $SNIPS_BY_CAT = {};
    $SNIPS_BY_NAME = [];
    my $files_seen = {};
    foreach my $snips_dir ( @snips_dirs ) {
        if ( opendir ( SNIPSDIR, $snips_dir )) {
            my @dirents = readdir ( SNIPSDIR );
            closedir ( SNIPSDIR );
            foreach ( sort ( @dirents )) {
                if ( -d $snips_dir.'/'.$_ ) {
                    next;
                }
                if ( m,^[.][.]?$,so ) { # skip current/parent directory
                    next;
                }
                if ( m,$snip_ignore_files_rx,s ) { # skip ignored files
                    next;
                }
                my $file = $_;
                if ( !$files_seen->{$file} ) {
                    my ( $cat, $name ) = split ( /_/, $file, 2 );
                    push ( @{$SNIPS_BY_NAME}, [ $name, $file, $snips_dir ]);
                    if ( !$name ) {
                        $name = $cat;
                        $cat = 'none';
                    }
                    $SNIPS_BY_CAT->{$cat}->{$snips_dir}->{$file} = [ $name, $file, $snips_dir ];
                    $files_seen->{$file} = 1;
                    #snip_msg ( " :DBG:  adding file `%s` (%s)\n", $file, $snips_dir ) if $DEBUG > 2;
                } else {
                    snip_msg ( " :DBG:  file `%s` (%s) already seen. skipping...\n",
                               $file, $snips_dir ) if $DEBUG > 2;
                }
            }
        }
    }
    return;
}

# VOID snips_ensure_snippets_collected ( snips-dir, ... )
sub snips_ensure_snippets_collected {
    if ( $#{$SNIPS_BY_NAME} < 0 ) {
        snips_collect_snippets( @_ );
    }
    return;
}

# snips_iterate ( CALLBACK[, CALLBACK_DATA[, NAME_RX[, ACCEPT_CAT_RX[, IGNORE_CAT_RX ]]]])
sub snips_iterate {
    my $callback = shift;
    my $callback_data = shift;
    my $name_rx = shift;
    if ( !defined ( $name_rx )) {
        $name_rx = $opt_name_rx;
    }
    my $accept_cat_rx = shift;
    if ( !defined ( $accept_cat_rx )) {
        $accept_cat_rx = $opt_accept_cat_rx;
    }
    my $ignore_cat_rx = shift;
    if ( !defined ( $ignore_cat_rx )) {
        $ignore_cat_rx = $opt_ignore_cat_rx;
    }
    my $result = [];

    snip_msg ( " :DBG:  %-*s: [%s] accept_cat_rx: [%s] ignore_cat_rx: [%s]\n",
               $dbg_fwid || 15, 'find file w/name_rx',
               $name_rx, $accept_cat_rx, $ignore_cat_rx ) if $DEBUG > 1;

    my @categories = sort ( keys ( %{$SNIPS_BY_CAT}));
    foreach my $category ( @categories ) {
        if ( $category =~ m,$ignore_cat_rx,s ) {
            next;
        }
        if ( $category !~ m,$accept_cat_rx,s ) {
            next;
        }
        foreach my $dir ( sort ( keys ( %{$SNIPS_BY_CAT->{$category}}))) {
            foreach my $file ( sort ( keys ( %{$SNIPS_BY_CAT->{$category}->{$dir}}))) {
                if ( $file !~ m,$name_rx,s ) {
                    next;
                }
                my @cb_res = &{$callback}( $callback_data, $dir, $file );
                if ( $#cb_res > 0 ) {
                    push ( @{$result}, $cb_res[ 1 ]);
                }
                if ( !$cb_res[ 0 ]) {
                    return $result;
                }
            }
        }
    }
    return $result;
}

sub snips_cb_list {
    my $cmd = shift;
    my $dir = shift;
    my $file = shift;
    if (!$opt_mode_seen) {
        my $mode;
        my $cat_pfx_part = $file;
        $cat_pfx_part =~ s,[.].*,,so;
        if ( $cat_pfx_part !~ m,_,so ) {
            # no category defined
            $mode = $SNIPS_MODE;
        } else {
            $mode = $cat_pfx_part;
            $mode =~ s,_.*,,so;
        }
        snip_set_at_replacement('mode', $mode);
    }
    $cmd = snip_replace($cmd);
    printf STDOUT ( "%s%-32s %s %s\n",
                    $cmd,
                    sprintf ( "'^%s\$'", sq ( $file )),
                    $opt_fn_sep,
                    $dir.'/'.$file );
    return ( 1 );
}

sub snips_cb_list_as_includes {
    my $data = shift;
    my $dir = shift;
    my $file = shift;
    my $cmd = $data->[ 0 ];
    my $trail = $data->[ 1 ];
    my $fwid = 32;
    if ( !$trail ) {
        $fwid = 0;
    }
    printf STDOUT ( "%s%-*s%s\n",
                    $cmd,
                    $fwid, sprintf ( "^%s\$", snip_quote_file( $file )),
                    $trail );
    return ( 1 );
}

sub snips_cb_grep {
    my $cmd = shift;
    my $dir = shift;
    my $file = shift;

    my $gcmd = sprintf ( "grep %s '%s' /dev/null",
                         $opt_grep_opts, sq ( $dir.'/'.$file ));
    system ( $gcmd );
    return ( 1 );
}

sub snips_cb_grep_as_includes {
    my $data = shift;
    my $dir = shift;
    my $file = shift;
    my $cmd = $data->[ 0 ];
    my $trail = $data->[ 1 ];
    my $fwid = 32;
    if ( !$trail ) {
        $fwid = 0;
    }
    # -l, --files-with-matches
    my $gcmd = sprintf ( "grep %s '%s' /dev/null",
                         $opt_grep_opts, sq ( $dir.'/'.$file ));
    my $gres = `$gcmd`;
    $gres =~ s,[ \t\r\n]+$,,so;
    if ( $gres ) {
        printf STDOUT ( "%s%-*s%s\n",
                        $cmd,
                        $fwid, sprintf ( "^%s\$", $file ),
                        $trail );
    }
    return ( 1 );
}

sub snips_cb_find {
    my $cont = shift;
    my $dir = shift;
    my $file = shift;
    snip_msg ( " ".":DBG:  %-*s: [%s] cont: %d\n", $dbg_fwid || 15, "cb_file",
               $dir.'/'.$file || '', $cont ) if $DEBUG > 1;
    return ( $cont, $dir.'/'.$file );
}

# snips_find_file ( ANY, ALL[, NAME_RX[, ACCEPT_CAT_RX[, IGNORE_CAT_RX ]]])
sub snips_find_file {
    my $any = shift;
    my $all = shift;
    my $name_rx = shift;
    my $result = snips_iterate ( \&snips_cb_find, $all, $name_rx, @_ );
    if ( $any && $#{$result} < 0 ) {
        $result = snips_iterate ( \&snips_cb_find, $all, $name_rx, '.*', '^$' );
    }
    return $result;
}

# |||:sec:||| text chunks
# a chunk is defined as [ TXT, type, is_txt ]
# is_txt can be:
# -1 = undecided
#  0 = no text
#  1 = text
my $chunks = [];

# chunk types are registered
my $chunk_types = {};

my $chi_txt = 0;
my $chi_type = 1;
my $chi_is_body = 2;

sub chunk_register_type {
    my $type = shift;
    my $is_txt = shift;
    $chunk_types->{$type} = [ $is_txt, @_ ];
}

# known types
chunk_register_type ( 'hdr', 0 );
chunk_register_type ( 'body', 1 );
chunk_register_type ( 'body-top', 1 );
chunk_register_type ( 'body-bot', 1 );
chunk_register_type ( 'ftr', 0 );

# set type of chunk
sub chunk_set_type {
    my $chunk = shift;
    my $type = shift;
    splice ( @{$chunk}, 1 );
    if ( exists ( $chunk_types->{$type} )) {
        push ( @{$chunk}, $type, @{$chunk_types->{$type}}, @_ );
    } else {
        push ( @{$chunk}, $type, -1, @_ );
    }
    return $chunk;
}

# create a chunk from type
sub chunk_create {
    my $type = shift;
    return chunk_set_type ( [ '' ], $type, @_ );
}

# --------------------------------------------------
#   STRING = chunk_dump ()
sub chunk_dump {
    my $chunk = shift;
    return sprintf ( "[ %-9s %s, '%s' ]",
                     $chunk->[ $chi_type ].',',
                     $chunk->[ $chi_is_body ] ? 'y' : 'n',
                     dbg_trunc_str ( $chunk->[ $chi_txt ]),
                   );
}

sub chunk_stack_dump {
    my $chunks = shift;
    my $reverse = shift;
    if ( $reverse ) {
        $chunks = [ reverse ( @{$chunks} )];
    }
    my $indx = 0;
    foreach my $chunk ( @{$chunks} ) {
        snip_msg ( " :CHK:  %d %s\n", $indx, chunk_dump ( $chunk ));
        ++$indx;
    }
    return;
}

# |||:sec:||| tag translation
my $snips_tag_trans =
    {
     # 'snap' => 'snp'
    };

sub snips_tag_trans {
    my $tag = shift;
    if ( exists ( $snips_tag_trans->{$tag} )) {
        $tag = $snips_tag_trans->{$tag};
    }
    return $tag;
}

# |||:sec:||| processing
my $snpc_ind_txt = 0;           # snippet text
my $snpc_ind_hdr = 1;           # snippet header
my $snpc_ind_ftr = 2;           # snippet footer
my $snpc_ind_rpl = 3;           # snippet `replace` flag
my $snpc_ind_prc = 4;           # snippet `processing' flag
my $snpc_ind_fil = 5;           # snippet filename
my $snpc_ind_lno = 6;           # snippet line number
my $snpc_ind_sts = 7;           # snippet `start seen' flag
my $snpc_ind_stp = 8;           # snippet `stop seen flag'
my $snpc_ind_inc = 9;           # snippet `including' flag
my $snpc_ind_ind = 10;          # snippet indent
my $snpc_ind_mrk = 11;          # snippet mark begin, mark end, mark replacement flag
my $snpc_ind_cst = 12;          # chunks |:todo:|
my $snpc_ind_col = 13;          # snippet `collect` info
my $snpc_ind_tit = 14;          # snippet title
my $snpc_ind_sta = 15;          # snippet start args
my $snpc_ind_oid = 16;          # snippet uuid
my $snpc_ind_max = 17;          # first unused index

my $snpc_fields =
    [
     'txt',
     'hdr',
     'ftr',
     'rpl',
     'prc',
     'fil',
     'lno',
     'sts',
     'stp',
     'inc',
     'skp',
     'mrk',
     'cst',
     'col',
     'tit',
     'sta',
     'oid',
    ];

sub snips_ctx_chunks {
    my $context = shift;
    if ( wantarray ) {
        snip_msg ( " :DBG:  %s wantarray\n", 'snips_ctx_chunks' ) if $DEBUG || 1;
        return ( @{$context->[ $snpc_ind_cst ]});
    } else {
        return ( $context->[ $snpc_ind_cst ]);
    }
}

sub snips_ctx_chunk {
    my $context = shift;
    return snips_ctx_chunks ( $context )->[ 0 ];
}

sub snips_ctx_add_chunk {
    my $context = shift;
    my $chunk = shift;
    my $chunks = snips_ctx_chunks( $context );
    unshift ( @{$chunks}, $chunk );
}

sub snips_process_context {
    my $replace = shift;
    if ( !defined ( $replace )) {
        $replace = $opt_replace;
    }
    my $process = shift;
    if ( !defined ( $process )) {
        $process = $opt_process;
    }
    my $file_name = shift || 'string';
    my $line_no = shift || 0;
    my $context = [ '', '', '', $replace, $process, $file_name, $line_no, 0, 0, 0, 0, [], [], [], $opt_title, '', $opt_uuid];
    my $chunk = chunk_create ( 'unk' );
    snips_ctx_add_chunk ( $context, $chunk );
    return $context;
}

sub snips_context_string {
    my $context = shift;
    my @string = ();
    my $indx = 0;
    foreach my $elt ( @{$context} ) {
        my $msg = repr($elt);
        if ( !defined ( $msg )) {
            $msg = '<<<undef>>>';
        }
        push (@string, sprintf('%s: [%s]', $snpc_fields->[$indx], $msg));
        $indx += 1;
    }
    return ''.join(', ', @string);
}

sub snips_context_filename {
    my $context = shift;
    my $file_name = snip_get_at_replacement('snip_self');
    if (!$file_name) {
        $file_name = $context->[ $snpc_ind_fil ] || 'no_file';
    }
    return $file_name;
}

sub snip_msgc {
    my $context = shift;
    my $file_name = snips_context_filename($context);
    my $line_no = $context->[$snpc_ind_lno];
    my $format = shift;
    $format = sprintf("%s:%d: %s", $file_name, $line_no, $format);
    snip_msg ( $format, @_ );
}

# --------------------------------------------------
# |||:sec:||| snippet command options
# --------------------------------------------------

my $snp_tag_opt_defs_ =
    [
     ["#subst#", [{}, {}, {}]],
     ["#undef#", [{}, {}]],
     ["process", 0],               # $context->[ $snpc_ind_prc ]
     ["skip", !$opt_no_skip ],     # !$opt_no_skip
     ["indent", !$opt_no_indent ], # !$opt_no_indent
#     ["final",  !$opt_no_final ],  # !$opt_no_final
     ["replace", 0],               # $context->[ $snpc_ind_rpl ]
     ["export", 1],
     ["import", 1],
     ["accept", $opt_accept_cat_rx, 1],
     ["ignore", $opt_ignore_cat_rx, 1],
    ];

my $snp_tag_opt_defs = {};

foreach my $opt_def ( @{$snp_tag_opt_defs_} ) {
    my $keyword = $opt_def->[0];
    $snp_tag_opt_defs->{$keyword} = $opt_def;
}

my $snp_tag_opt_keywords = [sort(keys(%{$snp_tag_opt_defs}))];

sub snp_tag_opt_dump_keywords {
    print("[\n# '".join("',\n# '", sort(@{$snp_tag_opt_keywords}))."',\n],\n\$context");
}
#snp_tag_opt_dump_keywords(); exit(0); # |:debug:|

# |||:sec:||| snippet command options
sub snp_arg_is_keyword_min {
    my $arg = shift;
    my $keyword = shift;
    my $min_len = shift || 0;

    my $argl = length($arg);
    my $keyl = length($keyword);
    my $match = (($argl <= $keyl) && ($arg eq substr($keyword, 0, $argl)));
    if ( $match ) {
        # an exact match is always valid!
        # Min len can be greater than actual option length, for e.g.:
        #   --some         => min_len = 5
        #   --some-thing   => min_len = 5
        # snip_msg ( " ".":DBG:| %-*s: al[%2d] kl[%2d] ml[%2d] a[%s] k[%s]\n", $dbg_fwid || 15,
        #          "arg_is_kw", $argl, $keyl, $min_len, $arg || '', $keyword || '' )
        #     if $DEBUG > 7;
        if ( $argl != $keyl && $argl < $min_len ) {
            return -1;
        }
        return 1;
    }
    return 0;
}

sub snp_arg_is_keyword {
    my $arg = shift;
    my $keyword = shift;
    my $match = snp_arg_is_keyword_min($arg, $keyword, @_);
    if ( $match < 0 ) {
        snip_msg("warning: ambiguous option [%s]", $keyword);
        $match = 0;
    }
    return $match;
}

# make a copy of the standard option definitions
sub snp_tag_opt_defs_copy {
    my $opt_defs_in = shift || $snp_tag_opt_defs;
    my $opt_defs = {};
    foreach my $keyword ( keys(%{$opt_defs_in})) {
        my $opt_def = $opt_defs_in->{$keyword};
        my $opt_def_copy = [ @{$opt_def} ];
        my $value = $opt_def_copy->[1];
        if ( ref($value) eq 'ARRAY') {
            my $value_copy = [];
            foreach my $val_elt(@{$value}) {
                my $val_ref = ref($val_elt);
                if ($val_ref eq 'HASH') {
                    push(@{$value_copy}, { %{$val_elt} });
                } elsif ($val_ref eq 'ARRAY') {
                    push(@{$value_copy}, [ @{$val_elt} ]);
                } else {
                    if ($val_ref) {
                        snip_msg("warning: snp_tag_opt_defs_copy: don't know how to copy `%s'\n", $val_elt);
                    }
                    push(@{$value_copy}, $val_elt);
                }
            }
            $opt_def_copy->[1] = $value_copy;
        }
        $opt_defs->{$keyword} = $opt_def_copy;
    }
    return $opt_defs;
}

# make copy of standard option definitions and fill defaults from context
sub snp_tag_opt_defs_context {
    my $context = shift || snips_process_context();
    my $opt_defs = snp_tag_opt_defs_copy();
    if (exists($opt_defs->{'process'})) {
        $opt_defs->{'process'}->[ 1 ] = $context->[ $snpc_ind_prc ];
    }
    if (exists($opt_defs->{'skip'})) {
        $opt_defs->{'skip'}->[ 1 ] = !$opt_no_skip;
    }
    if (exists($opt_defs->{'indent'})) {
        $opt_defs->{'indent'}->[ 1 ] = !$opt_no_indent;
    }
    # if (exists($opt_defs->{'final'})) {
    #     $opt_defs->{'final'}->[ 1 ] = !$opt_no_final;
    # }
    if (exists($opt_defs->{'replace'})) {
        $opt_defs->{'replace'}->[ 1 ] = $context->[ $snpc_ind_rpl ];
    }
    if (exists($opt_defs->{'accept'})) {
        $opt_defs->{'accept'}->[ 1 ] = $opt_accept_cat_rx;
    }
    if (exists($opt_defs->{'ignore'})) {
        $opt_defs->{'ignore'}->[ 1 ] = $opt_ignore_cat_rx;
    }
    return $opt_defs;
}

sub snp_tag_opt_defs_filter {
    my $filter = shift || [];
    my $context = shift || snips_process_context();
    my $opt_defs = snp_tag_opt_defs_context($context);
    my $res_defs = {};
    foreach my $keyword ( @{$filter} ) {
        my $def = [ $keyword ];
        my $ref = ref($keyword);
        if ($ref eq 'ARRAY') {
            $def = $keyword;
            $keyword = $def->[0];
        }
        if ( exists($opt_defs->{$keyword})) {
            my $odef = $opt_defs->{$keyword};
            if (scalar(@{$def}) > 1) {
                $odef->[1] = $def->[1];
            }
            $def = $odef;
        }
        $res_defs->{$keyword} = $def;
    }
    return $res_defs;
}

sub snp_tag_opt_defs_disambiguate {
    my $opt_defs = shift;
    # |:todo:|
    # make keyword abbreviations unambiguous
    my $keywords = [sort(keys(%{$opt_defs}))];
    foreach my $opt_def ( values(%{$opt_defs})) {
        $opt_def->[3] = 0;
    }
    foreach my $opt_def ( values(%{$opt_defs} )) {
        my $keyword = $opt_def->[0];
        my $kw_min_len = $opt_def->[3] || 1;
        my $kw_start = substr($keyword, 0 , $kw_min_len);
        foreach my $kw_check( @{$keywords} ) {
            if ($kw_check ne $keyword) {
                my $od_check = $opt_defs->{$kw_check};
                my $od_check_min_len = $od_check->[ 3 ];
                while ($kw_start eq substr($kw_check, 0 , $kw_min_len)) {
                    if ( $kw_min_len < $od_check_min_len) {
                        $kw_min_len = $od_check_min_len;
                    } else {
                        $kw_min_len += 1;
                        $od_check->[ 3 ] = $kw_min_len;
                    }
                    $kw_start = substr($keyword, 0, $kw_min_len);
                }
                $opt_def->[ 3 ] = $kw_min_len;
            }
        }
    }
    return;
}

sub snp_tag_opt_defs_dump {
    my $opt_defs = shift;
    if ( $opt_defs ) {
        foreach my $keyword ( sort(keys(%{$opt_defs}))) {
            my $opt_def = $opt_defs->{$keyword};
            my $od_len = @{$opt_def};
            my $default = $opt_def->[1];
            my $expect =  $od_len > 2 ? $opt_def->[2] : 0;
            my $min_len = $od_len > 3 ? $opt_def->[3] : -1;
            snip_msg ( " ".":DBG:  %-*s: exp[%d], min[%d] def[%s]\n",
                       $dbg_fwid || 15,
                       'opt: '.( $keyword || ''),
                       $expect || 0,
                       $min_len || 0,
                       $default || '<NONE>',
                     );
        }
    }
    return;
}

sub snp_tag_opt {
    my $keyword = shift;        #0
    my $values = shift || [];   #1
    my $negate = shift || 0;    #2
    my $opt_def = shift;        #3
    my $arg = shift;            #4
    my $amb = shift || [];      #5
    return [$keyword, $values, $negate, $opt_def, $arg, $amb ];
}

sub snp_tag_opts_from_arr {
    my $opt_arr = shift || [];
    my $opts = {};
    my $aindx = 0;
    foreach my $opt ( @{$opt_arr} ) {
        $opts->{sprintf('%05d', $aindx)} = $opt;
        $aindx += 1;
    }
    return $opts;
}

sub snp_tag_opts_dump {
    my $opts = shift;
    if ( $opts ) {
        my $max_wid = 0;
        foreach my $keyword ( sort(keys(%{$opts}))) {
            my $opt = $opts->{$keyword};
            my $option = $opt->[0] || '<NONE>';
            my $olen = length($option);
            if ($max_wid < $olen) {
                $max_wid = $olen;
            }
        }
        foreach my $keyword ( sort(keys(%{$opts}))) {
            my $opt = $opts->{$keyword};

            my $option = $opt->[0] || '<NONE>';
            my $values = $opt->[1] || [];
            my $negate = $opt->[2] || 0;
            my $opt_def = $opt->[3];
            my $arg = $opt->[4] || '<NONE>';
            my $amb = $opt->[5] || [];
            my $val_rep = join(', ', map { $_ || '0' } @{$values} );
            if ( $keyword eq '#subst#') {
                my @counts =
                    (
                     scalar(keys(%{$values->[0]})),
                     scalar(keys(%{$values->[1]})),
                     scalar(keys(%{$values->[2]})),
                    );
                $val_rep = join(', ', map { $_ || '0' } @counts );
            }
            if ( $keyword eq '#undef#') {
                my @counts =
                    (
                     scalar(keys(%{$values->[0]})),
                     scalar(keys(%{$values->[1]})),
                    );
                $val_rep = join(', ', map { $_ || '0' } @counts );
            }
            my $amb_rep = join(', ', @{$amb} );
            if ($amb_rep) {
                $amb_rep = sprintf(' amb[%s]', $amb_rep);
            }
            snip_msg ( " ".":DBG:  %-*s: neg[%d] def[%d] opt[%s] val%-3s%s\n",
                       $dbg_fwid || 15,
                       'opt arg: '.( $arg || ''),
                       $negate,
                       $opt_def ? 1 : 0,
                       sprintf('%-*s', $max_wid, $option),
                       sprintf('[%s]', $val_rep),
                       $amb_rep,
                     );
            if ( $keyword eq '#subst#') {
                my $replacements_del = $values->[0];
                if ( keys(%{$replacements_del})) {
                    snip_msg("#subst# replacements_del\n");
                    snip_replacements_dump($replacements_del, '');
                }
                my $replacements_rst = $values->[1];
                if ( keys(%{$replacements_rst})) {
                    snip_msg("#subst# replacements_rst\n");
                    snip_replacements_dump($replacements_rst, '');
                }
                my $replacements_add = $values->[2];
                if ( keys(%{$replacements_add})) {
                    snip_msg("#subst# replacements_add\n");
                    snip_replacements_dump($replacements_add, '');
                }
            } elsif ( $keyword eq '#undef#') {
                my $replacements_nx_del = $values->[0];
                if ( keys(%{$replacements_nx_del})) {
                    snip_msg("#undef# replacements_nx_del\n");
                    snip_replacements_dump($replacements_nx_del, '');
                }
                my $replacements_nx_rst = $values->[1];
                if ( keys(%{$replacements_nx_rst})) {
                    snip_msg("#undef# replacements_nx_rst\n");
                    snip_replacements_dump($replacements_nx_rst, '');
                }
            }
        }
    }
    return;
}

sub snp_tag_opt_analyze {
    my $opt_defs = shift;
    my $arg = shift;
    my $ambiguous_options = [];
    # opt_def, values, negate, ambiguous_options
    my $opt = snp_tag_opt( undef, undef, undef, undef, $arg, $ambiguous_options );
    if ( !$arg ) {
        return $opt;
    }
    my $argc = lc($arg);
    foreach my $keyword (%{$opt_defs}) {
        my $opt_def = $opt_defs->{$keyword};
        my $opt_min_len = $opt_def->[3];
        my $match = snp_arg_is_keyword_min($argc, $keyword, $opt_min_len);
        if ($match <= 0) {
            if ($match < 0) {
                push(@{$ambiguous_options}, $keyword );
            }
            next;
        }
        $opt->[0] = $keyword;
        my $value = $opt_def->[1];
        if (ref($value) eq 'ARRAY') {
            $opt->[1] = [@{$value}];
        } else {
            push(@{$opt->[1]}, $value);
        }
        $opt->[3] = $opt_def;
        last;
    }
    my $ambiguous_options_s = join(', ', @{$ambiguous_options} );
    if ($ambiguous_options_s) {
        snip_msg("warning: ambiguous option [%s] matches %s.\n", $arg, $ambiguous_options_s);
    }
    return $opt;
}

sub check_snp_tag_get_opt {
    if (1) {
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        my $opt_defs = snp_tag_opt_defs_context();
        snp_tag_opt_defs_dump($opt_defs);
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        snp_tag_opt_defs_disambiguate($opt_defs);
        snp_tag_opt_defs_dump($opt_defs);
    }

    if (1) {
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        my $opt_defs = snp_tag_opt_defs_filter(["import", "ignore", "export", ["experimental", 5]]);
        snp_tag_opt_defs_disambiguate($opt_defs);
        snp_tag_opt_defs_dump($opt_defs);
    }

    if (1) {
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        my $opt_defs = snp_tag_opt_defs_filter([@{$snp_tag_opt_keywords}, ["experimental", 5]]);
        snp_tag_opt_defs_disambiguate($opt_defs);
        my $args =
            [
             "process",
             "pRocess",
             "eX",
             "eXpe",
             "not-found",
            ];
        $DEBUG = 8;
        my $opts = [];
        foreach my $arg (@{$args}) {
            my $opt = snp_tag_opt_analyze($opt_defs, $arg);
            push(@{$opts}, $opt);
        }
        $opts = snp_tag_opts_from_arr($opts);
        snp_tag_opts_dump($opts);
    }

    if (1) {
        my $opt_defs = snp_tag_opt_defs_filter([@{$snp_tag_opt_keywords}, ["experimental", 5]]);
        my $targs = "include_.*_any !process !r !e abc=\@|cde\@ nl=\@|space\@ -zzz -empty accept .*";
        my $get_opt_res = snp_tag_get_opt(undef, $targs, $opt_defs, 1);
        my $res_parg = $get_opt_res->[0];
        my $res_opts = $get_opt_res->[1];
        my $res_defs = $get_opt_res->[2];
        my $res_optu = $get_opt_res->[3];
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        printf STDERR ( "# |".":DBG:| %-*s: [%s]\n", $dbg_fwid || 15, "res_parg", join(', ', @{$res_parg}) || '' );
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        snp_tag_opt_defs_dump($res_defs);
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        snp_tag_opts_dump($res_opts);
        printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        snp_tag_opts_dump(snp_tag_opts_from_arr($res_optu));
    }
    return;
}

sub check_snp_tag_get_opt2 {
    my $targs = "include_.*_any !process !r !e abc=\@|cde\@ nl=\@|space\@ -zzz -empty accept .*";
    my $opt_defs_kw =
        [
         @{$snp_tag_opt_keywords},
         ["defined", 5],
         ["eq", 5],
        ];
    my $opt_defs = snp_tag_opt_defs_filter($opt_defs_kw);
    my $get_opt_res = snp_tag_get_opt(undef, $targs, $opt_defs, 1);
    my $res_parg = $get_opt_res->[0];
    my $res_opts = $get_opt_res->[1];
    my $res_defs = $get_opt_res->[2];
    my $res_optu = $get_opt_res->[3];

    # |:here:|||<-here->|| options
}

#check_snp_tag_get_opt2(); exit(0); # |:debug:|

sub snp_tag_get_opt {
    my $context = shift || snips_process_context();
    my $args = shift;
    my $allowed = shift;
    my $parg_count = shift || 0;

    if ( !defined ( $allowed )) {
        $allowed = snp_tag_opt_defs_context($context);
    }
    if ( ref($allowed) eq 'HASH') {
        $allowed = [values(%{$allowed})];
    }

    my $opt_defs = {};
    foreach my $opt_def (@{$allowed} ) {
        my $keyword = $opt_def;
        my $opt_default = undef;
        my $opt_expect = 0;
        if (ref($opt_def) eq 'ARRAY') {
            $keyword = $opt_def->[0];
            $opt_default = $opt_def->[1];
            $opt_expect = $opt_def->[2] || 0;
        }
        $opt_defs->{$keyword} = [ $keyword, $opt_default, $opt_expect, 1 ];
    }

    snp_tag_opt_defs_disambiguate($opt_defs);

    my $opts = {};

    # setup defaults
    foreach my $keyword (sort(keys(%{$opt_defs}))) {
        my $opt_def = $opt_defs->{$keyword};
        my $default = $opt_def->[1];
        if (ref($default) ne 'ARRAY') {
            $default = [$default];
        }
        $opts->{$keyword} =  snp_tag_opt($keyword, $default);
    }

    my $subst_allowed = exists($opt_defs->{'#subst#'});
    my $undef_allowed = exists($opt_defs->{'#undef#'});

    my $replacements_del = {};
    my $replacements_rst = {};
    my $replacements_add = {};

    my $replacements_nx_del = {};
    my $replacements_nx_rst = {};
    my $values = [];

    if ( $subst_allowed ) {
        $values = $opts->{'#subst#'}->[1];
        @{$values} = ( $replacements_del, $replacements_rst, $replacements_add );
    }
    if ( $undef_allowed ) {
        $values = $opts->{'#undef#'}->[1];
        @{$values} = ( $replacements_nx_del, $replacements_nx_rst );
    }

    if (ref($args) ne 'ARRAY') {
        my @args = split(/[ \t\r\n]+/, $args);
        $args = \@args;
    }

    my $positional_args = [];
    while ($parg_count > 0) {
        push(@{$positional_args}, shift(@{$args}));
        $parg_count -= 1;
    }

    my $unknown_opts = [];
    my $result = [ $positional_args, $opts, $opt_defs, $unknown_opts ];

    my $current_opt = snp_tag_opt();
    my $current_expect = 0;
    my $negate = 0;

    foreach my $arg (@{$args} ) {
        if ( $current_expect > 0) {
            push(@{$current_opt->[ 1 ]}, $arg);
            $current_expect -= 1;
            next;
        }

        if ($subst_allowed && $arg =~ m/=/soi ) { # substitution
            my ( $key, $value ) = split(/=/, $arg, 2);
            my @nkeys = snip_normalize_at_key($key);
            my $nkey = $nkeys[1];
            if (snip_is_at_replacement_defined($nkey)) {
                $replacements_rst->{$nkey} =
                    snip_get_at_replacement($nkey);
            } else {
                $replacements_del->{$nkey} = 1;
            }
            $replacements_add->{$nkey} = $value;
            # ignore previous undef of replacement
            delete($replacements_nx_del->{$nkey});
            delete($replacements_nx_rst->{$nkey});
            next;
        } elsif ( $undef_allowed && $arg =~ m/^-/so ) { # undefine
            my $key = $';
            my @nkeys = snip_normalize_at_key($key);
            my $nkey = $nkeys[1];
            if (snip_is_at_replacement_defined($nkey)) {
                $replacements_nx_rst->{$nkey} =
                    snip_get_at_replacement($nkey);
            } else {
                $replacements_nx_del->{$nkey} = 1;
            }
            # ignore previous definition of replacement
            delete($replacements_add->{$nkey});
            delete($replacements_rst->{$nkey});
            delete($replacements_del->{$nkey});
            next;
        }

        while ( $arg =~ m/^!/so ) {
            $negate = !$negate;
            $arg = $';
        }
        if (!$arg) {
            next;
        }

        $current_opt = snp_tag_opt();
        my $argc = lc($arg);
        my $argl = length($arg);

        my $known = 0;
        my $opt = snp_tag_opt_analyze($opt_defs, $arg);
        my $opt_def = $opt->[3];
        if ($opt_def) {
            $current_opt = [@{$opt}];
            my $keyword = $current_opt->[0];

            if ( $negate ) {
                my $xkeyword = $keyword;
                if ( $keyword eq 'accept') {
                    $xkeyword = 'ignore';
                } elsif ( $keyword eq 'ignore') {
                    $xkeyword = 'accept';
                }
                if ($xkeyword ne $keyword) {
                    $opt_def = $opt_defs->{$xkeyword};
                    $opt->[0] = $xkeyword;
                    $opt->[3] = $opt_def;
                    $negate = 0;
                }
            }

            my $values = $current_opt->[1];
            $current_opt->[2] = $negate;
            $current_expect = $opt_def->[2];
            if ($current_expect == 0) {
                $values->[ 0 ] = $negate ? 0 : 1;
            } else {
                # remove default for options with arguments
                pop(@{$values});
            }

            $opts->{$keyword} = $current_opt;
            $known = 1;
        }
        if ( !$known) {
            $opt->[2] = $negate;
            push(@{$unknown_opts}, $opt);
            if ( !scalar(@{$opt->[5]})) {
                snip_msgc ($context, "warning: unknown state argument [%s]\n", $arg || '' )
                    if $VERBOSE;
            }
        }
        $negate = 0;
    }

    return $result;
}

# |||:sec:||| generic ||<-snap->|| handlers
sub snp_tag_handler_keep {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    # return ( text, done )
    return ( $text );
}

sub snp_tag_handler_ignore {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    # return ( text, done )
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    return ( '' );
}

sub snp_tag_handler_unknown {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    if ( $VERBOSE ) {
        snip_msgc ($context, " warning: unknown tag `%s` with args `%s`\n",
                   $tag, $targs );
    }
    return ( $text )
}

# |||:sec:||| ||<-snip->|| handlers
my $opt_relaxed_start_stop = 0; # |:todo:| make configuration option

sub snip_tag_handler_null {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    if ( $opt_relaxed_start_stop && $VERBOSE < 2 ) {
        my $start_seen = $context->[ $snpc_ind_sts ];
        if ( !$start_seen ) {
            $context->[ $snpc_ind_sts ] = 1;
            $context->[ $snpc_ind_hdr ] = $context->[ $snpc_ind_txt ];
            $context->[ $snpc_ind_txt ] = '';
            return ( '', 1 );
        } else {
            $context->[ $snpc_ind_stp ] = 1;
            return ( '', 1 );
        }
    } else {
        snip_msgc ($context, " warning: unhandled null tag seen\n") if $VERBOSE;
    }
    return ( $text );
}

sub snp_tag_handler_capture {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    # must always be activated to prevent unwanted output at collection time.
    my $args = [split(/[ \t\r\n]+/, $targs)];

    my $action = $args->[0];
    if ( !defined ( $action )) {
        if ($context->[$snpc_ind_prc]) {
            snip_msg("warning: snp_tag_handler_capture: no action specfied\n");
        }
        return $text;
    }

    # |:todo:| capture interface ...
    my $capture_text = '';
    if ($action eq 'on') {
        snip_capture_start();
    } elsif ($action eq 'off') {
        $capture_text = snip_capture_stop();
    } elsif ($action eq 'clear') {
        $snip_capture_context->[1] = '';
    } elsif ($action eq 'get') {
        $capture_text = $snip_capture_context->[1];
    } elsif ($action eq 'drop') {
        snip_capture_stop();
    }

    if ( $context->[$snpc_ind_rpl]) {
        $SNIPS_REPLACEMENTS_FINAL = snip_parse_subst_args($targs, $SNIPS_REPLACEMENTS_FINAL);
    }

    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }

    return ( $capture_text );
}

sub snp_tag_handler_debug {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    my $final = 0;
    my $negate = 0;
    my $debug;
    eval { $debug = $targs; };
    $DEBUG = $debug;
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    return ( '' );
}

sub snp_tag_handler_show {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    my $final = 0;
    my $negate = 0;
    my $done = 0;
    foreach my $key (split(/[ \t\r\n]+/, $targs)) {
        while ( $key =~ m/^!/so ) {
            $negate = !$negate;
            $key = $';
        }
        if (!$key) {
            next;
        }
        if ($key eq 'final') {
            $final = $negate ? 0 : 1;
            $negate = 0;
            next;
        }
        my $value;
        if ($final) {
            $value = snip_get_at_replacement_final($key, '<undef>');
        } else {
            $value = snip_get_at_replacement($key, '<undef>');
        }
        if ( $DEBUG ) {
            snip_msgc ($context, " ".":SHW:  %-*s: [%s]\n", $dbg_fwid || 15,
                       ($final ? 'fin ' : 'std ').$key,
                       dbg_flatten_str($value) || '' );
        } else {
            snip_msg (" ".":SHW:  %-*s: [%s]\n", $dbg_fwid || 15,
                      ($final ? 'fin ' : 'std ').$key,
                      dbg_flatten_str($value) || '' );
        }
        $done = 1;
    }
    my $repl_list = '';
    if (!$done) {
        snip_msgc($context, "---------- all%s replacements----------\n", $final ? ' final' : '');
        if ( $final ) {
            snip_replacements_dump($SNIPS_REPLACEMENTS_FINAL, '')
        } else {
            snip_replacements_dump(undef, '')
        }
    }
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    return ( $repl_list );
}

sub snip_tag_handler_start {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    if ( $VERBOSE < 2 && $type eq 'snip' ) {
        my $start_seen = $context->[ $snpc_ind_sts ];
        if ( $start_seen ) {
            snip_msgc ($context, "warning: duplicate start tag ignored\n") if $VERBOSE;
        } else {
            $context->[ $snpc_ind_sts ] = 1;
            $context->[ $snpc_ind_hdr ] = $context->[ $snpc_ind_txt ];
            $context->[ $snpc_ind_txt ] = '';
            $context->[ $snpc_ind_ind ] = 0;
            $context->[ $snpc_ind_sta ] = $targs;
            return ( '', 1 );
        }
    }
    return ( $text );
}

my $snip_tag_stop_hook = [];

sub snip_tag_handler_stop {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    if ( $VERBOSE < 2 && $type eq 'snip' ) {
        my $start_seen = $context->[ $snpc_ind_sts ];
        my $stop_seen = $context->[ $snpc_ind_stp ];
        if ( $stop_seen ) {
            snip_msgc ($context, "warning: duplicate stop tag (%d already seen)\n",
                       $stop_seen, $tag, $targs ) if $VERBOSE;
        } else {
            foreach my $hook_func ( @{$snip_tag_stop_hook} ) {
                &{$hook_func}( $context, $text, $targs, $tag, $type );
            }
            if ( !$start_seen ) {
                snip_msgc ($context, "warning: stop tag seen without start tag\n",
                           $tag, $targs ) if $VERBOSE;
            }
            $context->[ $snpc_ind_ind ] = 0;
        }
        ++$context->[ $snpc_ind_stp ];
        return ( '', 1 );
    }
    return ( $text );
}

sub snip_tag_handler_title {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    # return ( text, done )
    if (!$context->[$snpc_ind_tit]) {
        if (!$context->[$snpc_ind_inc]) {
            $context->[$snpc_ind_tit] = $targs;
        }
    }
    if (!snip_get_at_replacement('snip_title')) {
        snip_set_at_replacement('snip_title', $targs);
    }
    if (!snip_get_at_replacement('snip_title_user')) {
        snip_set_at_replacement('snip_title_user', $targs);
    }
    snip_set_at_replacement('snip_title_last', $targs);
    return snp_tag_handler_keep ( @_ );
}

sub snip_tag_handler_uuid {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    # return ( text, done )
    if (!$context->[$snpc_ind_oid]) {
        $context->[$snpc_ind_oid] = $targs; # |:check:|
    }
    my $snip_uuid = snip_get_at_replacement('snip_uuid');
    if (!snip_get_at_replacement('snip_uuid')) {
        snip_set_at_replacement('snip_uuid', $targs);
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "setup snip_uuid", $targs || '' )
            if $DEBUG > 6;
    } else {
        snip_msg ( " ".":DBG:  %-*s: [%s] dropping [%s]\n", $dbg_fwid || 15, "exist snip_uuid", $snip_uuid || '', $targs || '' )
            if $DEBUG > 50;
    }
    snip_set_at_replacement('snip_uuid_last', $targs);
    return snp_tag_handler_keep ( @_ );
}

# |||:sec:||| ||<-snap->|| handlers
sub snp_tag_handler_mark {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    my $name = snip_replace('@snip_self@');
    $name =~ s,.*/,,so;
    my $sep = '';
    if (!$targs) {
        $targs = '';
        if ($context->[$snpc_ind_tit]) {
            $targs .= $sep.$context->[$snpc_ind_tit];
            $sep = ' - ';
        } else {
            my $snip_title = snip_get_at_replacement('snip_title');
            if ( $snip_title ) {
                $targs .= $sep.$snip_title;
                $sep = ' - ';
            }
        }
        if ($context->[$snpc_ind_sta]) {
            $targs .= $sep.$context->[$snpc_ind_sta];
        } else {
            $targs .= $sep.snip_replace('@dts@');
        }
    }
    if ( $targs ) {
        $sep = ' | ';
    }
    $context->[ $snpc_ind_mrk ] =
        [
         snip_comment ( snip_mtagf ( "beg %s%s%s\n", $name, $sep, $targs)),
         snip_comment ( snip_mtagf ( "end %s\n", $name )),
         # remember replacement flag at time of mark handling
         $context->[ $snpc_ind_rpl ],
        ];
    return ( '' );
}

sub snp_tag_handler_indent {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    my $sign = 1;
    my $relative = 0;
    while ( $targs =~ m/^([-+])/so) {
        $relative = 1;
        if ( $1 eq '+') {
            $sign = 1;
        } else {
            $sign = -1;
        }
        $targs = $';
    }
    $targs =~ s,^[ \t\r]+,,sog;
    if ( $targs !~ m/^[0-9]+$/so) {
        snip_msg("warning: indent (%s) is not numeric\n", $targs);
    } else {
        if ( !$opt_no_indent) {
            my $indent = eval { $targs };
            if ( $relative ) {
                $indent *= $sign;
                $context->[$snpc_ind_ind] += $indent;
            } else {
                $context->[$snpc_ind_ind] = $indent;
            }
        }
    }
    return ( '' )
}

sub snp_tag_handler_trim {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    if ( !$targs ) {
        $targs = "all";
    }
    my $left;
    my $right;
    my $stext = $context->[ $snpc_ind_txt ];
    local ($_);
    foreach ( split(/[ \t\r\n]+/, $targs )) {
        if (snp_arg_is_keyword(lc($_), "left")) {
            $left = 1;
        } elsif (snp_arg_is_keyword(lc($_), "right")) {
            $right = 1;
        } elsif (snp_arg_is_keyword(lc($_), "all")) {
            $left = 1;
            $right = 1;
        } else {
            # |:todo:| error message
        }
    }
    if ( $left) {
        $stext =~ s,^[ \t\r\n]+,,so;
    }
    if ( $right ) {
        $stext =~ s,[ \t\r\n]+$,,so;
        if ($stext) {
            $stext .= "\n";
        }
    }
    $context->[ $snpc_ind_txt ] = $stext;
    return ( '' );
}

sub snp_tag_handler_drop {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    $context->[ $snpc_ind_txt ] = '';
    return ( '' );
}

sub snp_tag_handler_quote {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "text", $tag, dbg_flatten_str($text) || '' )
        if $DEBUG > 6;

    $text = $targs;
    if ( !defined ( $text )) {
        $text = '';
    }
    if ( $text ) {
        $text .= "\n"
    }
    return ( $text );
}

sub snp_tag_handler_todo {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $sep = ' ';
    if ( !defined ( $targs )) {
        $targs = '';
        $sep = '';
    }
    my $todo_tag = snip_replace('@tag_pfx@todo@tag_sfx@');
    $targs = snip_comment($todo_tag.$sep.$targs); # make the tag configurable
    return snp_tag_handler_quote($context, $text, $targs, $tag, $type );
}

# |||:sec:||| collector

my $snpu_ind_txt = 0;
my $snpu_ind_prc = 1;
my $snpu_ind_rpl = 2;
my $snpu_ind_res = 3;
my $snpu_ind_id  = 4;
my $snpu_ind_cb  = 5;
my $snpu_ind_cba = 6;
my $snpu_ind_uu0 = 7;
my $snpu_ind_uu1 = 8;
my $snpu_ind_uu2 = 9;
my $snpu_ind_vrb = 10;
my $snpu_ind_ind = 11;
my $snpu_ind_noi = 12;
my $snpu_ind_nsk = 13;
my $snpu_ind_lno = 14;
my $snpu_ind_hnd = 15;

# Terminates collecting, invokes callback and returns collect_param.
sub snp_tag_collect_end {
    my ( $context, $id ) = ( @_ );
    my $collect_param = shift(@{$context->[ $snpc_ind_col ]});
    if ( $collect_param ) {
        if ( $id ne '*' && $collect_param->[ $snpu_ind_id ] ne $id ) {
            snip_msg( " ".":DBG:  %-*s: [%s] != [%s]\n", $dbg_fwid || 15, "reject id", $id || '', $collect_param->[ $snpu_ind_id ])
                if $DEBUG > 5;
            unshift(@{$context->[ $snpc_ind_col ]} , $collect_param);
            $collect_param = undef;
        } else {
            snip_msg( " ".":DBG:  %-*s: [%s] [%d] [%s]\n", $dbg_fwid || 15,
                      "close collector", $id || '', $context->[$snpc_ind_lno],
                      join( '] [',
                            map { dbg_format_if_array($_);}
                            @{$collect_param->[$snpu_ind_cba]}))
                if $DEBUG > 5;
            my $callback = $collect_param->[$snpu_ind_cb];
            if ( $callback ) {
                $collect_param->[$snpu_ind_res] = &{$callback}($collect_param, $context);
            }
            $context->[ $snpc_ind_txt ] = $collect_param->[$snpu_ind_txt];
            $context->[ $snpc_ind_prc ] = $collect_param->[$snpu_ind_prc];
            $context->[ $snpc_ind_rpl ] = $collect_param->[$snpu_ind_rpl];
            if ($collect_param->[$snpu_ind_vrb]) {
                $context->[ $snpc_ind_ind ] = $collect_param->[$snpu_ind_ind];
                $opt_no_skip = $collect_param->[$snpu_ind_nsk];
                $opt_no_indent = $collect_param->[$snpu_ind_noi];
            }
            if ($context->[ $snpc_ind_prc ]) {
                #snips_handlers_drop(); # |:handler:| keep aliases
            } else {
                #snips_handlers_pop(); # |:handler:| restore aliases
            }
        }
    } else {
        snip_msg( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "collect_end", 'empty collector stack')
            if $DEBUG > 7;
    }
    return $collect_param;
}

sub snp_tag_handler_collect {
    my ( $context, $id, $callback, $args, $processing, $replace, $verbatim ) = ( @_ );
    my $collect_param = snp_tag_collect_end ( $context, $id );
    if ( !$collect_param ) {
        #snips_handlers_push(); # |:handler:|
        $collect_param =
            [
             $context->[ $snpc_ind_txt ], # 0
             $context->[ $snpc_ind_prc ], # 1
             $context->[ $snpc_ind_rpl ], # 2
             '',                          # 3 result
             $id,                         # 4
             $callback,                   # 5
             [ @{$args} ],                # 6
             0,                           # 7
             0,                           # 8
             0,                           # 9
             $verbatim,                   # 10
             $context->[ $snpc_ind_ind ], # 11
             $opt_no_indent + 0,          # 12
             $opt_no_skip + 0,            # 13
             $context->[ $snpc_ind_lno ], # 14
             undef,                       # 15 |:handler:| reserved for handlers
            ];
        snip_msg( " ".":DBG:  %-*s: [%s] [%d] [%s]\n", $dbg_fwid || 15,
                  "open collector", $id || '', $context->[$snpc_ind_lno],
                  join( '] [',
                        map { dbg_format_if_array($_);}
                        @{$collect_param->[$snpu_ind_cba]}))
            if $DEBUG > 5;
        unshift(@{$context->[ $snpc_ind_col ]} , $collect_param);
        $context->[ $snpc_ind_txt ] = '';
        $context->[ $snpc_ind_prc ] = $processing;
        $context->[ $snpc_ind_rpl ] = $replace;
        if ( $verbatim ) {
            $context->[ $snpc_ind_ind ] = 0;
            $opt_no_skip = 1;
            $opt_no_indent = 1;
        }
        return ('');
    }
    return ($collect_param->[$snpu_ind_res]);
}

sub snp_tag_collect_end_hook {
    my ( $context ) = ( @_ );
    while (snp_tag_collect_end( $context, '*' )) {
        # nothing to do
    }
}
push ( @{$snip_tag_stop_hook}, \&snp_tag_collect_end_hook );

sub snp_tag_collect_last {
    my ( $context ) = ( @_ );
    if ($#{$context->[ $snpc_ind_col ]} < 0) {
        return undef;
    }
    return $context->[ $snpc_ind_col ]->[0];
}

sub snp_tag_collect_text_cb {
    my ( $collect_param, $context ) = ( @_ );
    return $context->[ $snpc_ind_txt ];
}

sub check_snip_parse_subst_args {
    my $check_replacements = {};

    my $sv_replacements = snip_replacements_save();
    snip_replacements_dump($check_replacements, '');

    snip_replacements_restore($sv_replacements);
}
#check_snip_parse_subst_args(); exit(0);        # |:debug:|

sub snip_parse_subst_args {
    my $targs = shift || '';
    my $dst_replacements = shift;
    my $src_replacements = shift;
    my $old_replacements;

    my $sv_replacements;
    if ($src_replacements) {
        $sv_replacements = snip_replacements_save($src_replacements);
    }
    # remove one level of quoting
    $targs = snip_replace_quoted($targs);
    my $defs = [];
    if ( $targs =~ m/^[ \t][^ \t\r\n=]+=/so ) {
        foreach my $arg (split (/[ \t\r\n]+/, $targs )) {
            my ($key, $value) = split (/=/, $arg );
            push(@{$defs}, [$key, $value]);
        }
    } else {
        my ($key, $value) = split (/[ \t\r\n]+/, $targs, 2 );
        push(@{$defs}, [$key, $value]);
    }
    foreach my $def (@{$defs} ) {
        my $key = $def->[0];
        my $value = $def->[1];
        if ( !$value ) {
            $value = '';
        } else {
            $value = snip_replace($value);
            $value = snip_replace_quoted($value);
        }
        $def->[1] = $value;
    }

    if ($dst_replacements) {
        $old_replacements = snip_replacements_save($dst_replacements);
    }

    foreach my $def (@{$defs} ) {
        my $key = $def->[0];
        my $value = $def->[1];
        snip_set_at_replacement($key, $value);
    }

    my $cur_replacements;
    if ($sv_replacements) {
        $cur_replacements = snip_replacements_restore($sv_replacements);
    } elsif ($old_replacements) {
        $cur_replacements = snip_replacements_restore($old_replacements);
    }
    return $cur_replacements;
}

sub snp_tag_handler_undef {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    my ($key) = $targs;
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    if ( $context->[$snpc_ind_rpl]) {
        snip_del_at_replacement($key);
    }
    return ( '' );
}

my $snip_block_start_lilne_ofs = 1;

sub snp_tag_handler_define {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $get_opt_res;
    my $snippet = '';
    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":TGI:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id ne $tag ) {
        # open collector
        # process options
        my $opt_defs = snp_tag_opt_defs_filter
            ([
              '#subst#',
              '#undef#',
              # 'accept',
              'export',
              # 'ignore',
              'import',
              ['process', 0],
              ['replace', 0],
              'skip',
              'indent',
              ['final', 0],
              ['default', 0],
              ['unquote', 0],
             ],
             $context);
        # remove one level of quoting
        $targs = snip_replace_quoted($targs);
        my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 1);
        snips_handlers_push();      # |:handler:| save for aliases
        snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [$get_opt_res, $targs, $text],
                                0, 0, 1);
        $text = '';
    } else {
        # close collector
        $snippet = snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [], 0, 0, 1);
        my $replacing = $context->[$snpc_ind_rpl];
        snips_handlers_pop(); # |:handler:| remove aliases

        $processing = $context->[$snpc_ind_prc];
        if (!$processing) {
            if ( $replacing ) {
                $text = snip_replace( $text );
            }
            $text = ($collect_param->[$snpu_ind_cba]->[2].$snippet.$text);
        } else {
            $get_opt_res = $collect_param->[$snpu_ind_cba]->[0];

            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $key = $res_parg->[0];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            my $final = $res_opts->{'final'}->[1]->[0];
            my $default = $res_opts->{'default'}->[1]->[0];
            my $unquote = $res_opts->{'unquote'}->[1]->[0];

            if ( !$default ||
                 ($final ?
                  !defined(snip_get_at_replacement_final($key))
                  : !defined(snip_get_at_replacement($key)))) {
                my $value = $snippet;
                my $rpl_context;
                $rpl_context = snip_rpl_context_open_from_options($res_opts);
                if ( $process ) {
                    my $sv_txt = $context->[ $snpc_ind_txt ];
                    my $sv_prc = $context->[ $snpc_ind_prc ];
                    my $sv_rpl = $context->[ $snpc_ind_rpl ];
                    $context->[ $snpc_ind_txt ] = '';
                    $context->[ $snpc_ind_prc ] = $process;
                    $context->[ $snpc_ind_rpl ] = $replace;
                    $opt_no_skip = $no_skip;
                    $opt_no_indent = $no_indent;

                    snips_process_feed_string( $value, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);
                    $value = $context->[ $snpc_ind_txt ];

                    $opt_no_skip = $collect_param->[$snpu_ind_nsk];
                    $opt_no_indent = $collect_param->[$snpu_ind_noi];
                    $context->[ $snpc_ind_txt ] = $sv_txt;
                    $context->[ $snpc_ind_prc ] = $sv_prc;
                    $context->[ $snpc_ind_rpl ] = $sv_rpl;
                    $replace = 0;
                }
                $value =~ s,[ \t\r\n]+$,,so;
                if ( $replace ) {

                    $value = snip_replace($value);
                }
                if ( $unquote ) {
                    $value = snip_replace_quoted($value);
                }
                snip_rpl_context_close($rpl_context);
                if ( $final) {
                    snip_set_at_replacement_final($key, $value);
                } else {
                    snip_set_at_replacement($key, $value);
                }
            }
            $text = '';
        }
    }
    return($text);
}

sub snp_tag_handler_default {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    my ($key, $value) = split ( /[ \t\r\n]+/, $targs, 2 );
    if (!defined(snip_get_at_replacement($key))) {
        return snp_tag_handler_subst ( @_ );
    }
    return ( '' );
}

sub snp_tag_handler_subst {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    if ( $context->[$snpc_ind_rpl]) {
        snip_parse_subst_args($targs);
    }
    return ( '' );
}

sub snp_tag_handler_final {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    if (!$context->[$snpc_ind_prc]) {
        return $text;
    }
    if ( $context->[$snpc_ind_rpl]) {
        $SNIPS_REPLACEMENTS_FINAL = snip_parse_subst_args($targs, $SNIPS_REPLACEMENTS_FINAL);
    }
    return ( '' );
}

sub snp_tag_handler_alias {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    if ($context->[$snpc_ind_prc]) {
        $text = '';
    }

    # must always set/delete, so parsing works
    my $args = [split(/[ \t\r\n]+/, $targs)];
    if (scalar(@{$args}) > 2) {
        snip_msg("warning: snp_tag_handler_alias: too many arguments: [%s]\n", $targs);
        return $text;
        exit(1);                # |:debug:|
    }

    my $alias = $args->[0];
    if ( !defined ( $alias )) {
        my $handlers = snip_tag_get_handlers();
        snip_msg("---------- all aliases----------\n");
        foreach my $alias ( sort(keys(%{$handlers}))) {
            my $orig = $handlers->{$alias}->[3];
            if ($orig) {
                snip_msg ( " ".":ALS:  %-*s: [%s]\n", $dbg_fwid || 15,
                           $alias, $orig || '' );
            }
        }
        return $text;
    }
    my $ahandler = snip_tag_get_handler($alias);
    my $orig = $args->[1];
    if ( !defined ( $orig )) {
        if ( $ahandler ) {
            if ($ahandler->[3]) {
                snip_tag_set_handler($alias);
            } else {
                snip_msg("warning: snp_tag_handler_alias: `%s` is not an alias, cannot delete\n", $alias);
            }
        } else {
            snip_msg("warning: snp_tag_handler_alias: alias `%s` not found\n", $alias);
        }
    } else {
        if ($ahandler && !$ahandler->[3]) {
            snip_msg("warning: snp_tag_handler_alias: `%s` is not an alias, cannot set to `%s`\n", $alias, $orig);
            return $text;
        }
        my $handler = snip_tag_get_handler_copy($orig);
        if ( !defined ( $handler )) {
            my $def_alias = 'rem';
            snip_msg("warning: snp_tag_handler_alias: `%s` not found, setting alias `%s` to `%s` instead\n",
                     $orig, $alias, $def_alias);
            $orig = 'rem';
            $handler = snip_tag_get_handler_copy($def_alias);
        }
        # alias flag
        $handler->[3] = $orig;
        snip_tag_set_handler($alias, $handler);
    }
    return $text;
}

sub snp_tag_handler_verbatim {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq $tag ) {
        $VERBOSE = $collect_param->[$snpu_ind_uu0]; # |:info:| VERBOSE has nothing to do with it?
        # done
        my $vtext = '';
        my $snippet = snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [], 0, 0, 1);
        $processing = $context->[$snpc_ind_prc];
        my $cba = $collect_param->[$snpu_ind_cba];
        my $get_opt_res = $cba->[2];

        # restore handlers
        snips_handlers_pop();   # |:handler:|

        if ( $processing ) {
            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            my $unquote = $res_opts->{'unquote'}->[1]->[0];

            my $rpl_context;
            $rpl_context = snip_rpl_context_open_from_options($res_opts);
            my $sv_prc = $context->[ $snpc_ind_prc ];
            my $sv_rpl = $context->[ $snpc_ind_rpl ];
            $context->[ $snpc_ind_prc ] = $process;
            $context->[ $snpc_ind_rpl ] = $replace;
            $opt_no_skip = $no_skip;
            $opt_no_indent = $no_indent;

            # |:check:| unquote before processing?, catch process/replace, unquote, process/replace?
            if ( $unquote ) {
                if ($replace) {
                    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "replace1", dbg_flatten_str($snippet) || '' );
                    $snippet = snip_replace($snippet);
                }
                snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "unquote1", dbg_flatten_str($snippet) || '' );
                $snippet = snip_replace_quoted($snippet);
            }

            $vtext = $snippet;
            # snips_process_feed_string( $snippet, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);

            $opt_no_skip = $collect_param->[$snpu_ind_nsk];
            $opt_no_indent = $collect_param->[$snpu_ind_noi];
            $context->[ $snpc_ind_prc ] = $sv_prc;
            $context->[ $snpc_ind_rpl ] = $sv_rpl;
            $replace = 0;
            snip_rpl_context_close($rpl_context);
        }

        if (!$processing) {
            my $replace = $context->[$snpc_ind_rpl];
            if ( $replace ) {
                $snippet = snip_replace($snippet);
            }
            return($cba->[0].$snippet.$text);
        }
        $text = $vtext;
    } else {
        my $opt_defs = snp_tag_opt_defs_filter
            ([
              '#subst#',
              '#undef#',
              # 'accept',
              'export',
              # 'ignore',
              'import',
              'process',
              'replace',
              'skip',
              'indent',
              ['unquote', 0],
             ],
             $context);

        $targs = snip_replace_quoted($targs);
        my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 0);

        my $verbatim_handler = snip_tag_get_handler($tag);
        snips_handlers_push(snip_tag_handlers_new()); # |:handler:|
        snip_tag_set_handler($tag, $verbatim_handler);
        snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [ $text, $targs, $get_opt_res ], 0, 0, 1);
        $collect_param = snp_tag_collect_last($context); # |:info:| no influence?
        $collect_param->[$snpu_ind_uu0] = $VERBOSE;
        $VERBOSE = 0;
        $text = '';
    }
    return ( $text );
}

sub snp_tag_handler_snip {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq $tag ) {
        my $snippet = snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [], 0, 0, 1);
        $processing = $context->[$snpc_ind_prc];
        my $cba = $collect_param->[$snpu_ind_cba];
        my $get_opt_res = $cba->[2];

        if ( $processing ) {
            snips_handlers_drop(); # |:handler:| keep aliases
            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            my $unquote = $res_opts->{'unquote'}->[1]->[0];

            my $rpl_context;
            $rpl_context = snip_rpl_context_open_from_options($res_opts);
            my $sv_prc = $context->[ $snpc_ind_prc ];
            my $sv_rpl = $context->[ $snpc_ind_rpl ];
            $context->[ $snpc_ind_prc ] = $process;
            $context->[ $snpc_ind_rpl ] = $replace;
            $opt_no_skip = $no_skip;
            $opt_no_indent = $no_indent;

            # |:check:| unquote before processing?, catch process/replace, unquote, process/replace?
            if ( $unquote ) {
                if ($replace) {
                    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "replace1", dbg_flatten_str($snippet) || '' );
                    $snippet = snip_replace($snippet);
                }
                snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "unquote1", dbg_flatten_str($snippet) || '' );
                $snippet = snip_replace_quoted($snippet);
            }

            snips_process_feed_string( $snippet, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);

            $opt_no_skip = $collect_param->[$snpu_ind_nsk];
            $opt_no_indent = $collect_param->[$snpu_ind_noi];
            $context->[ $snpc_ind_prc ] = $sv_prc;
            $context->[ $snpc_ind_rpl ] = $sv_rpl;
            $replace = 0;
            snip_rpl_context_close($rpl_context);
        } else {
            snips_handlers_pop(); # |:handler:| remove aliases
        }

        if (!$processing) {
            my $replace = $context->[$snpc_ind_rpl];
            if ( $replace ) {
                $snippet = snip_replace($snippet);
            }
            return($cba->[0].$snippet.$text);
        }
        $text = '';
    } else {
        $targs = snip_replace_quoted($targs);

        my $opt_defs = snp_tag_opt_defs_filter
            ([
              '#subst#',
              '#undef#',
              # 'accept',
              'export',
              # 'ignore',
              'import',
              'process',
              'replace',
              'skip',
              'indent',
              ['unquote', 0],
             ],
             $context);
        my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 0);

        snips_handlers_push();      # |:handler:| save for aliases
        snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [ $text, $targs, $get_opt_res ], 0, 0, 1);
        $text = '';
    }
    return ( $text );
}

#check_snp_tag_get_opt(); exit(0); # |:debug:|

sub snp_tag_handler_read {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    # my @targs = split ( /[ \t\r\n]*,[ \t\r\n]*/, $targs );
    # snip_msg ( " :DBG:  \$targs: [%s]\n", $targs );
    # snip_msg ( " :DBG:  \@targs: [%s]\n", join ( '][', @targs ));
    # my $inc_file_rx = $targs[ 0 ];
    # my $inc_accept_cat_rx = $targs[ 1 ];
    # my $inc_ignore_cat_rx = $targs[ 2 ];

    # remove one level of quoting
    $targs = snip_replace_quoted($targs);

    my $opt_defs = snp_tag_opt_defs_filter([@{$snp_tag_opt_keywords}], $context);
    my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 1);
    my $res_parg = $get_opt_res->[0];
    my $res_opts = $get_opt_res->[1];
    my $res_defs = $get_opt_res->[2];
    my $res_optu = $get_opt_res->[3];

    my $inc_file_rx = $res_parg->[0];

    {
        my $sv_replacements = snip_replacements_save();
        if ( !snip_is_at_replacement_defined('snip_fn_space')) {
            snip_set_at_replacement('snip_fn_space', ' ');
        }
        if ( !snip_is_at_replacement_defined('snip_fn_tab')) {
            snip_set_at_replacement('snip_fn_tab', "\t");
        }
        if ( !snip_is_at_replacement_defined('snip_fn_cr')) {
            snip_set_at_replacement('snip_fn_cr', "\r");
        }
        if ( !snip_is_at_replacement_defined('snip_fn_nl')) {
            snip_set_at_replacement('snip_fn_nl', "\n");
        }
        $inc_file_rx = snip_replace__($inc_file_rx);
        $inc_file_rx = snip_replace_quoted($inc_file_rx);
        snip_replacements_restore($sv_replacements);
    }

    # |:here:| options

    my $process = $res_opts->{'process'}->[1]->[0];
    my $no_skip = !$res_opts->{'skip'}->[1]->[0];
    my $no_indent = !$res_opts->{'indent'}->[1]->[0];
    my $replace = $res_opts->{'replace'}->[1]->[0];
    my $export = $res_opts->{'export'}->[1]->[0];
    my $import = $res_opts->{'import'}->[1]->[0];
    my $accept_cat_rx = $res_opts->{'accept'}->[1]->[0];
    my $ignore_cat_rx = $res_opts->{'ignore'}->[1]->[0];

    snip_msg ( " ".":DBG:  %-*s: [%s] prc[%d] noskp[%d] noi[%d] rpl[%d] exp[%d] imp[%d] acc[%s] ign[%s]\n", $dbg_fwid || 15,
               "include args",
               $inc_file_rx || '',
               $process,
               $no_skip,
               $no_indent,
               $replace,
               $export,
               $import,
               $accept_cat_rx,
               $ignore_cat_rx,
             ) if $DEBUG > 1;

    my $inc_file = $inc_file_rx;
    if ( !( -r $inc_file || $inc_file =~ m,^/,so )) {
        # not an absolute filename or readable file
        {
            local ( $opt_accept_cat_rx ) = $accept_cat_rx;
            local ( $opt_ignore_cat_rx ) = $ignore_cat_rx;
            my $inc_files = snips_find_file ( 1, 0, $inc_file );
            $inc_file = $inc_files->[ 0 ];
        }
    }

    snip_msgc ($context, " ".":DBG:  %-*s: [%s]\n",
               $dbg_fwid || 15, "include file", $inc_file || '',
             ) if $DEBUG > 1;

    if ( $inc_file && -r $inc_file ) {

        ++$context->[ $snpc_ind_inc ];
        local ( $opt_no_skip ) = $no_skip;
        local ( $opt_no_indent ) = $no_indent;
        my $rpl_context;
        $rpl_context = snip_rpl_context_open_from_options($res_opts);
        $text = snips_read_file ( $inc_file );
        snip_rpl_context_close($rpl_context);
        --$context->[ $snpc_ind_inc ];

    } else {
        snip_msgc ($context, "warning: no include file found for `%s`\n",
                   $targs ) if $VERBOSE;
    }

    # return ( text, done )
    return ( $text );
}

sub snp_tag_handler_include {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    # my @targs = split ( /[ \t\r\n]*,[ \t\r\n]*/, $targs );
    # snip_msg ( " :DBG:  \$targs: [%s]\n", $targs );
    # snip_msg ( " :DBG:  \@targs: [%s]\n", join ( '][', @targs ));
    # my $inc_file_rx = $targs[ 0 ];
    # my $inc_accept_cat_rx = $targs[ 1 ];
    # my $inc_ignore_cat_rx = $targs[ 2 ];

    # remove one level of quoting
    $targs = snip_replace_quoted($targs);

    my $opt_defs = snp_tag_opt_defs_filter([@{$snp_tag_opt_keywords}], $context);
    my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 1);
    my $res_parg = $get_opt_res->[0];
    my $res_opts = $get_opt_res->[1];
    my $res_defs = $get_opt_res->[2];
    my $res_optu = $get_opt_res->[3];

    my $inc_file_rx = $res_parg->[0];

    {
        my $sv_replacements = snip_replacements_save();
        if ( !snip_is_at_replacement_defined('snip_fn_space')) {
            snip_set_at_replacement('snip_fn_space', ' ');
        }
        if ( !snip_is_at_replacement_defined('snip_fn_tab')) {
            snip_set_at_replacement('snip_fn_tab', "\t");
        }
        if ( !snip_is_at_replacement_defined('snip_fn_cr')) {
            snip_set_at_replacement('snip_fn_cr', "\r");
        }
        if ( !snip_is_at_replacement_defined('snip_fn_nl')) {
            snip_set_at_replacement('snip_fn_nl', "\n");
        }
        $inc_file_rx = snip_replace__($inc_file_rx);
        $inc_file_rx = snip_replace_quoted($inc_file_rx);
        snip_replacements_restore($sv_replacements);
    }

    # |:here:| options

    my $process = $res_opts->{'process'}->[1]->[0];
    my $no_skip = !$res_opts->{'skip'}->[1]->[0];
    my $no_indent = !$res_opts->{'indent'}->[1]->[0];
    my $replace = $res_opts->{'replace'}->[1]->[0];
    my $export = $res_opts->{'export'}->[1]->[0];
    my $import = $res_opts->{'import'}->[1]->[0];
    my $accept_cat_rx = $res_opts->{'accept'}->[1]->[0];
    my $ignore_cat_rx = $res_opts->{'ignore'}->[1]->[0];

    snip_msg ( " ".":DBG:  %-*s: [%s] prc[%d] noskp[%d] noi[%d] rpl[%d] exp[%d] imp[%d] acc[%s] ign[%s]\n", $dbg_fwid || 15,
               "include args",
               $inc_file_rx || '',
               $process,
               $no_skip,
               $no_indent,
               $replace,
               $export,
               $import,
               $accept_cat_rx,
               $ignore_cat_rx,
             ) if $DEBUG > 1;

    my $inc_file = $inc_file_rx;
    if ( !( -r $inc_file || $inc_file =~ m,^/,so )) {
        # not an absolute filename or readable file
        {
            local ( $opt_accept_cat_rx ) = $accept_cat_rx;
            local ( $opt_ignore_cat_rx ) = $ignore_cat_rx;
            my $inc_files = snips_find_file ( 1, 0, $inc_file );
            $inc_file = $inc_files->[ 0 ];
        }
    }

    snip_msgc ($context, " ".":DBG:  %-*s: [%s]\n",
               $dbg_fwid || 15, "include file", $inc_file || '',
             ) if $DEBUG > 1;

    if ( $inc_file && -r $inc_file ) {

        ++$context->[ $snpc_ind_inc ];
        local ( $opt_no_skip ) = $no_skip;
        local ( $opt_no_indent ) = $no_indent;
        my $rpl_context;
        $rpl_context = snip_rpl_context_open_from_options($res_opts);
        $text = snips_read_snippet ( $inc_file, $replace, $process, 1 );
        snip_rpl_context_close($rpl_context);
        --$context->[ $snpc_ind_inc ];

    } else {
        snip_msgc ($context, "warning: no include file found for `%s`\n",
                   $targs ) if $VERBOSE;
    }

    # return ( text, done )
    return ( $text );
}

sub snp_tag_handler_exec {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $get_opt_res;
    my $script = '';
    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":TGI:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq $tag ) {
        # close collector
        $script = snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [], 0, 0);

        $processing = $context->[$snpc_ind_prc];
        if (!$processing) {
            snips_handlers_pop(); # |:handler:| remove aliases
            $text = $script.$text; # |:todo:| this is wrong, the text should not be replaced
            my $replacing = $context->[$snpc_ind_rpl];
            if ( $replacing ) {
                $text = snip_replace( $text );
            }
        }

        $get_opt_res = $collect_param->[$snpu_ind_cba]->[0];

    } else {
        # open collector
        # process options
        my $opt_defs = snp_tag_opt_defs_filter
            ([
              '#subst#',
              '#undef#',
              # 'accept',
              'export',
              # 'ignore',
              'import',
              'process',
              'replace',
              ['dump', 0],
              'indent',
              'skip',
              ['autostart', 1],
              ['sprocess', $context->[$snpc_ind_prc]],
              ['sreplace', $context->[$snpc_ind_rpl]],
              ['sunquote', 1],
             ],
             $context);
        # remove one level of quoting
        $targs = snip_replace_quoted($targs);

        my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 0);
        my $res_opts = $get_opt_res->[1];
        my $process = $res_opts->{'process'}->[1]->[0];
        my $replace = $res_opts->{'replace'}->[1]->[0];
        my $sprocess = $res_opts->{'sprocess'}->[1]->[0];
        if (!$res_opts->{'sprocess'}->[4]) { # arg
            $sprocess = $process;
            $res_opts->{'sprocess'}->[1]->[0] = $sprocess;
        }
        my $sreplace = $res_opts->{'sreplace'}->[1]->[0];
        if (!$res_opts->{'sreplace'}->[4]) { # arg
            $sreplace = $replace;
            $res_opts->{'sreplace'}->[1]->[0] = $sreplace;
        }
        #snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "sprocess", $sprocess || '' );
        #snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "sreplace", $sreplace || '' );

        snips_handlers_push();      # |:handler:| save for aliases
        snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [$get_opt_res, $targs],
                                $sprocess, $sreplace);

        if ($processing) {
            return('');
        }
    }

    if (!$processing) {
        return $text;
    }
    snips_handlers_drop(); # |:handler:| keep aliases

    if ( $script ) {
        my $res_opts = $get_opt_res->[1];
        my $sunquote = $res_opts->{'sunquote'}->[1]->[0];
        if ($sunquote) {
            $script = snip_replace_quoted($script);
            # |:info:| this makes no sense ?
        }
        snip_msg ( " ".":EXC:  %-*s: [%s]\n", $dbg_fwid || 15, "script", dbg_flatten_str($script) || '' )
            if $DEBUG;
        $text = snips_read_file($script.' |', 1);
        if ( $@ ) {
            snip_msgc ($context, "warning: exec `%s` failed:\n",
                       $script ) ;
            my $err_txt = $@;
            $err_txt =~ s,[ \t\r\n]+$,,so;
            snip_msgc ($context, "`%s`\n",
                       $err_txt );
            $text = '';
        }
    } else {
        if ($VERBOSE) {
            snip_msgc ($context, "warning: empty exec\n") ;
        }
        $text = '';
    }

    if ( $text ) {
        my $res_parg = $get_opt_res->[0];
        my $res_opts = $get_opt_res->[1];
        my $res_defs = $get_opt_res->[2];
        my $res_optu = $get_opt_res->[3];

        my $process = $res_opts->{'process'}->[1]->[0];
        my $no_skip = !$res_opts->{'skip'}->[1]->[0];
        my $no_indent = !$res_opts->{'indent'}->[1]->[0];
        my $replace = $res_opts->{'replace'}->[1]->[0];
        my $export = $res_opts->{'export'}->[1]->[0];
        my $import = $res_opts->{'import'}->[1]->[0];
        my $autostart = $res_opts->{'autostart'}->[1]->[0];
        my $dump = $res_opts->{'dump'}->[1]->[0];

        # printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        # snp_tag_opt_defs_dump($res_defs);
        # printf STDERR ( "%s\n", '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' );
        # snp_tag_opts_dump($res_opts);

        # |:here:| options

        snip_msg ( " ".":DBG:  %-*s: prc[%d] noskp[%d] noi[%d] rpl[%d] exp[%d] imp[%d] auto[%d]\n", $dbg_fwid || 15,
                   "exec args",
                   $process,
                   $no_skip,
                   $no_indent,
                   $replace,
                   $export,
                   $import,
                   $autostart,
                 ) if $DEBUG > 1;

        ++$context->[ $snpc_ind_inc ];
        local ( $opt_no_skip ) = $no_skip;
        local ( $opt_no_indent ) = $no_indent;
        my $prolog;
        if ( $process && $autostart ) {
            # automatic snippet start
            $prolog = snip_tag_start('');
        } else {
            $prolog = '';
        }
        my $rpl_context;
        $rpl_context = snip_rpl_context_open_from_options($res_opts);
	if (!$dump) {
	    $text = snips_process_snippet ( $prolog.$text, '<exec:'.$context->[ $snpc_ind_lno ].'>', $replace, $process, 1 );
	}
        snip_rpl_context_close($rpl_context);
        --$context->[ $snpc_ind_inc ];
    }

    # return ( text, done )
    if ( !defined ( $text )) {
        $text = '';
    }
    return ( $text );
}

sub snp_tag_handler_shellq {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $script = $targs;
    my $processing = $context->[$snpc_ind_prc];

    if (!$processing) {
        return $text;
    }

    if ( $script ) {
        $text = snips_read_file($script.' |', 1);
        if ( $@ ) {
            snip_msgc ($context, "warning: exec `%s` failed:\n",
                       $script ) ;
            my $err_txt = $@;
            $err_txt =~ s,[ \t\r\n]+$,,so;
            snip_msgc ($context, "`%s`\n",
                       $err_txt );
            $text = '';
        }
    } else {
        if ($VERBOSE) {
            snip_msgc ($context, "warning: empty %s\n",
                       $tag ) ;
        }
        $text = '';
    }

    # return ( text, done )
    if ( !defined ( $text )) {
        $text = '';
    }
    return ( $text );
}

sub snp_tag_handler_shell {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    $text = snp_tag_handler_shellq ( @_ );

    if ( $text ne '' ) {
        my $replace = $context->[ $snpc_ind_rpl ];
        my $process = $context->[ $snpc_ind_prc ];
        if ( $replace || $process ) {
            ++$context->[ $snpc_ind_inc ];
            my $prolog;
            if ( $process ) {
                # automatic snippet start
                $prolog = snip_tag_start('');
            } else {
                $prolog = '';
            }
            $text = snips_process_snippet ( $prolog.$text, '<shell:'.$context->[ $snpc_ind_lno ].'>', $replace, $process, 1 );
            --$context->[ $snpc_ind_inc ];
        }
    }
    # return ( text, done )
    return ( $text );
}

sub snp_tag_handler_skip_cb {
    my ( $collect_param, $context ) = ( @_ );
    my $processing = $collect_param->[$snpu_ind_prc];
    my $args = $collect_param->[$snpu_ind_cba];
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "skip_cb", 'called' || '' )
        if $DEBUG > 7;
    if (!$processing && snp_arg_is_keyword(lc($args->[ 1 ]), "keep")) {
        # if not processing, keep skipped section
        my $replacing = $collect_param->[$snpu_ind_rpl];
        my $text = ($args->[ 0 ]
                  .$context->[ $snpc_ind_txt ]);
        if ( $replacing ) {
            $text = snip_replace( $text );
        }
        return $text;
    }
    return '';
}

sub snp_tag_handler_skip {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );
    local( $_ ) = $targs;
    my @args = split();
    if ( $opt_no_skip ) {
        unshift( @args, 'keep' );
    }
    unshift( @args, $text );
    # default: remove section even when not processing
    push ( @args, 'remove' );

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    my $result = snp_tag_handler_collect($context, $tag, \&snp_tag_handler_skip_cb, \@args, 0, 0);
    if ( $id eq $tag ) {
        # end
        my $processing = $context->[$snpc_ind_prc];
        snips_handlers_pop(); # |:handler:| remove aliases
    } else {
        # start
        snips_handlers_push();      # |:handler:| save for aliases
    }
    if ( $result ) {
        my $replacing = $collect_param->[$snpu_ind_rpl];
        if ( $replacing ) {
            $text = snip_replace( $text );
        }
        $result .= $text;
    }
    return $result;
}

sub snp_tag_handler_if {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    $targs = snip_replace_quoted($targs);

    local ( $_ ) = $targs;
    my $args = [split()];

    my $final = 0;
    my $negate = 0;
    my $cmd = '';
    my $indx = 0;
    foreach my $arg (@{$args} ) {
        $indx += 1;
        while ( $arg =~ m/^!/so ) {
            $negate = !$negate;
            $arg = $';
        }
        if (!$arg) {
            next;
        }
        my $argc = lc($arg);
        if (snp_arg_is_keyword($argc, "final")) {
            $final = $negate ? 0 : 1;
            $negate = 0;
            next;
        }
        $cmd = $arg;
        last;
    }

    my $condition = 1;
    my $cmdc = lc($cmd);

    if (snp_arg_is_keyword($cmdc, "defined")) {
        my $key = $args->[$indx];
        snip_msg ( " ".":DBG:  %-*s: [%s%s %s] [%s]\n", $dbg_fwid || 15, "condition", $final ? 'final ' : '', $negate ? '!' : '=', $cmd || '', $key )
            if $DEBUG > 5;
        if ( $final ) {
            $condition = snip_is_at_replacement_final_defined($key);
        } else {
            $condition = snip_is_at_replacement_defined($key);
        }
        if ( $negate) {
            $condition = !$condition;
        }
    } elsif (snp_arg_is_keyword($cmdc, "eq")) {
        my $key = $args->[$indx];
        my $cvalue = $args->[$indx+1];
        $indx += 1;
        if ( defined ( $cvalue )) {
            $cvalue = snip_replace($cvalue);
        }
        my $value;
        if ( $final ) {
            $value = snip_get_at_replacement_final($key, undef);
        } else {
            $value = snip_get_at_replacement($key, undef);
        }
        $condition = (defined($cvalue) == defined($value));
        if ($condition && defined($cvalue)) {
            $condition = ($value eq $cvalue);
        }
        if ( $negate) {
            $condition = !$condition;
        }
        my @nkeys = snip_normalize_at_key($key);
        my $akey = $nkeys[0];
        snip_msg ( " ".":CND:  %-*s: [%s %s=>%s] [%s%s] [%s] == %s\n", $dbg_fwid || 15,
                   "condition", $final ? 'fin' : 'std',
                   $akey || '', defined($value) ? $value : '<undef>',
                   $negate ? '!' : '', $cmd || '',
                   defined($cvalue) ? $cvalue : '<undef>',
                   $condition ? "true" : "false")
            if $DEBUG > 5;
    } else {
        snip_msg ( "|".":ERR:| %-*s: [%s%s %s]\n", $dbg_fwid || 15, "unknown condition", $final ? 'final ' : '', $negate ? '!' : '=', $cmd || '' );
        # treat as true
    }

    $indx += 1;
    my $opt_defs = snp_tag_opt_defs_filter
        ([
          '#subst#',
          '#undef#',
          # 'accept',
          'export',
          # 'ignore',
          'import',
          'process',
          'replace',
          'skip',
          'indent',
          #['unquote', 0],
         ],
         $context);
    my $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, $indx);
    snips_handlers_push();      # |:handler:| save for aliases
    snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [ $condition, $text, $args, 0, $get_opt_res ], 0, 0, 1);
    my $collect_param = snp_tag_collect_last($context);
    $collect_param->[$snpu_ind_id] = 'fi';
    return('');
}

sub snp_tag_handler_elif {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq 'fi' ) {
        my $snippet = snp_tag_handler_collect($context, 'fi', \&snp_tag_collect_text_cb, [], 0, 0, 1);
        $processing = $context->[$snpc_ind_prc];
        my $cba = $collect_param->[$snpu_ind_cba];
        my $condition = $cba->[0];
        my $done = $cba->[3];
        my $get_opt_res = $cba->[4];

        if ( $processing && !$done && $condition ) {
            snips_handlers_drop(); # |:handler:| keep aliases
            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            #my $unquote = $res_opts->{'unquote'}->[1]->[0];

            my $rpl_context;
            $rpl_context = snip_rpl_context_open_from_options($res_opts);
            my $sv_prc = $context->[ $snpc_ind_prc ];
            my $sv_rpl = $context->[ $snpc_ind_rpl ];
            $context->[ $snpc_ind_prc ] = $process;
            $context->[ $snpc_ind_rpl ] = $replace;
            $opt_no_skip = $no_skip;
            $opt_no_indent = $no_indent;

            snips_process_feed_string( $snippet, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);

            $opt_no_skip = $collect_param->[$snpu_ind_nsk];
            $opt_no_indent = $collect_param->[$snpu_ind_noi];
            $context->[ $snpc_ind_prc ] = $sv_prc;
            $context->[ $snpc_ind_rpl ] = $sv_rpl;
            $replace = 0;
            # if ( $unquote ) {
            #   $snippet = snip_replace_quoted($snippet);
            # }
            snip_rpl_context_close($rpl_context);
        } else {
            snips_handlers_pop(); # |:handler:| remove aliases
        }
        $done = ($done || $condition);

        if (!$processing) {
            my $replace = $context->[$snpc_ind_rpl];
            my $fin_snippet = $cba->[1].$snippet;
            if ( $replace ) {
                $fin_snippet = snip_replace($fin_snippet);
            }
            $context->[ $snpc_ind_txt ] .= ($fin_snippet);
        }

        if ($done) {
            my $args = $cba->[2];
            snips_handlers_push();      # |:handler:| save for aliases
            snp_tag_handler_collect($context, 'if', \&snp_tag_collect_text_cb, [ !$condition, $text, $args, $done, $get_opt_res ], 0, 0, 1);
            my $collect_param_c = snp_tag_collect_last($context);
            $collect_param_c->[$snpu_ind_id] = 'fi';
        } else {
            snp_tag_handler_if ($context, $text, $targs, 'if', $type );
        }

        $text = '';
    } else {
        snip_msg ( "|".":ERR:| elif without if\n" );
        if ($processing) {
            return('');
        }
    }
    return ( $text );
}

sub snp_tag_handler_else {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq 'fi' ) {
        my $snippet = snp_tag_handler_collect($context, 'fi', \&snp_tag_collect_text_cb, [], 0, 0, 1);
        $processing = $context->[$snpc_ind_prc];
        my $cba = $collect_param->[$snpu_ind_cba];
        my $condition = $cba->[0];
        my $done = $cba->[3];
        my $get_opt_res = $cba->[4];

        if ( $processing && !$done && $condition ) {
            snips_handlers_drop(); # |:handler:| keep aliases
            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            #my $unquote = $res_opts->{'unquote'}->[1]->[0];

            my $rpl_context;
            $rpl_context = snip_rpl_context_open_from_options($res_opts);
            my $sv_prc = $context->[ $snpc_ind_prc ];
            my $sv_rpl = $context->[ $snpc_ind_rpl ];
            $context->[ $snpc_ind_prc ] = $process;
            $context->[ $snpc_ind_rpl ] = $replace;
            $opt_no_skip = $no_skip;
            $opt_no_indent = $no_indent;

            snips_process_feed_string( $snippet, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);

            $opt_no_skip = $collect_param->[$snpu_ind_nsk];
            $opt_no_indent = $collect_param->[$snpu_ind_noi];
            $context->[ $snpc_ind_prc ] = $sv_prc;
            $context->[ $snpc_ind_rpl ] = $sv_rpl;
            $replace = 0;
            # if ( $unquote ) {
            #   $snippet = snip_replace_quoted($snippet);
            # }
            snip_rpl_context_close($rpl_context);
        } else {
            snips_handlers_pop(); # |:handler:| remove aliases
        }
        $done = ($done || $condition);

        if (!$processing) {
            my $replace = $context->[$snpc_ind_rpl];
            my $fin_snippet = $cba->[1].$snippet;
            if ( $replace ) {
                $fin_snippet = snip_replace($fin_snippet);
            }
            $context->[ $snpc_ind_txt ] .= ($fin_snippet);
        }

        my $args = $cba->[2];
        if ( !$done ) {
            $targs = snip_replace_quoted($targs);
            local ( $_ ) = $targs;
            $args = [split()];

            my $opt_defs = snp_tag_opt_defs_filter
                ([
                  '#subst#',
                  '#undef#',
                  # 'accept',
                  'export',
                  # 'ignore',
                  'import',
                  'process',
                  'replace',
                  'skip',
                  'indent',
                  #['unquote', 0],
                 ],
                 $context);
            $get_opt_res = snp_tag_get_opt($context, $targs, $opt_defs, 0);
        }

        snips_handlers_push();      # |:handler:| save for aliases
        snp_tag_handler_collect($context, 'if', \&snp_tag_collect_text_cb, [ !$condition, $text, $args, $done, $get_opt_res ], 0, 0, 1);
        my $collect_param_c = snp_tag_collect_last($context);
        $collect_param_c->[$snpu_ind_id] = 'fi';

        $text = '';
    } else {
        snip_msg ( "|".":ERR:| else without if\n" );
        if ($processing) {
            return('');
        }
    }
    return ( $text );
}

sub snp_tag_handler_fi {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    my $processing = $context->[$snpc_ind_prc];

    my $collect_param = snp_tag_collect_last($context);
    my $id = $collect_param ? $collect_param->[$snpu_ind_id] : '';
    snip_msg ( " ".":DBG:  %-*s: [%s] [%s]\n", $dbg_fwid || 15, "tag/id", $tag, $id || '' )
        if $DEBUG > 5;
    if ( $id eq $tag ) {
        my $snippet = snp_tag_handler_collect($context, $tag, \&snp_tag_collect_text_cb, [], 0, 0, 1);
        $processing = $context->[$snpc_ind_prc];
        my $cba = $collect_param->[$snpu_ind_cba];
        my $condition = $cba->[0];
        my $done = $cba->[3];
        my $get_opt_res = $cba->[4];

        if ( $processing && !$done && $condition ) {
            snips_handlers_drop(); # |:handler:| keep aliases
            my $res_parg = $get_opt_res->[0];
            my $res_opts = $get_opt_res->[1];
            my $res_defs = $get_opt_res->[2];
            my $res_optu = $get_opt_res->[3];

            my $process = $res_opts->{'process'}->[1]->[0];
            my $no_skip = !$res_opts->{'skip'}->[1]->[0];
            my $no_indent = !$res_opts->{'indent'}->[1]->[0];
            my $replace = $res_opts->{'replace'}->[1]->[0];
            my $export = $res_opts->{'export'}->[1]->[0];
            my $import = $res_opts->{'import'}->[1]->[0];
            #my $unquote = $res_opts->{'unquote'}->[1]->[0];

            my $rpl_context;
            $rpl_context = snip_rpl_context_open_from_options($res_opts);
            my $sv_prc = $context->[ $snpc_ind_prc ];
            my $sv_rpl = $context->[ $snpc_ind_rpl ];
            $context->[ $snpc_ind_prc ] = $process;
            $context->[ $snpc_ind_rpl ] = $replace;
            $opt_no_skip = $no_skip;
            $opt_no_indent = $no_indent;

            snips_process_feed_string( $snippet, $context, $collect_param->[$snpu_ind_lno] + $snip_block_start_lilne_ofs);

            $opt_no_skip = $collect_param->[$snpu_ind_nsk];
            $opt_no_indent = $collect_param->[$snpu_ind_noi];
            $context->[ $snpc_ind_prc ] = $sv_prc;
            $context->[ $snpc_ind_rpl ] = $sv_rpl;
            $replace = 0;
            # if ( $unquote ) {
            #   $snippet = snip_replace_quoted($snippet);
            # }
            snip_rpl_context_close($rpl_context);
        } else {
            snips_handlers_pop(); # |:handler:| remove aliases
        }
        $done = ($done || $condition);

        if (!$processing) {
            my $replace = $context->[$snpc_ind_rpl];
            my $fin_snippet = $cba->[1].$snippet.$text;
            if ( $replace ) {
                $fin_snippet = snip_replace($fin_snippet);
            }
            return($fin_snippet);
        }
        $text = '';
    } else {
        snip_msg ( "|".":ERR:| fi without if\n" );
        if ($processing) {
            return('');
        }
    }
    return ( $text );
}

# |:DEPRECATED:|
sub snp_tag_handler_evalq {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    $text = eval $targs;
    if ( $@ ) {
        if ( $VERBOSE ) {
            snip_msgc ($context, "warning: eval `%s` failed:\n",
                       $targs ) ;
            my $err_txt = $@;
            $err_txt =~ s,[ \t\r\n]+$,,so;
            snip_msgc ($context, "`%s`\n",
                       $err_txt );
        }
        $text = '';
    }

    # return ( text, done )
    if ( !defined ( $text )) {
        $text = '';
    }
    return ( $text );
}

# |:DEPRECATED:|
sub snp_tag_handler_eval {
    my ( $context, $text, $targs, $tag, $type ) = ( @_ );

    $text = snp_tag_handler_evalq ( @_ );

    if ( $text ne '' ) {
        my $replace = $context->[ $snpc_ind_rpl ];
        my $process = $context->[ $snpc_ind_prc ];
        if ( $replace || $process ) {
            ++$context->[ $snpc_ind_inc ];
            $text = snips_process_snippet ( $text, '<eval:'.$context->[ $snpc_ind_lno ].'>', $replace, $process, 1 );
            --$context->[ $snpc_ind_inc ];
        }
    }
    # return ( text, done )
    return ( $text );
}

# |||:sec:||| handler demux
# [ handler-ref, ALWAYS-PROCESS ]
# if ALWAYS-PROCESS is true, the handler is always invoked, no matter
# what the global processing flag is.
my $snip_tag_handlers =
    {
     # tag => [ handler, always ]
     ''        => [ \&snip_tag_handler_null, $opt_relaxed_start_stop ],
     'capture' => [ \&snp_tag_handler_capture, 1 ],
     'debug'   => [ \&snp_tag_handler_debug, 1 ],
     'show'    => [ \&snp_tag_handler_show, 1 ],
     'alias'   => [ \&snp_tag_handler_alias, 1 ],

     'start'   => [ \&snip_tag_handler_start, 2 ],
     'stop'    => [ \&snip_tag_handler_stop, 2 ],
     'title'   => [ \&snip_tag_handler_title, 2 ],
     'uuid'    => [ \&snip_tag_handler_uuid, 2 ],

     'mark'    => [ \&snp_tag_handler_mark, 0 ],
     'beg'     => [ \&snp_tag_handler_keep, 3 ], # marked section begin
     'end'     => [ \&snp_tag_handler_keep, 3 ], # marked section end

     'indent'  => [ \&snp_tag_handler_indent ],

     'rem'     => [ \&snp_tag_handler_ignore ],
     'trim'    => [ \&snp_tag_handler_trim ],
     'drop'    => [ \&snp_tag_handler_drop ],
     'quote'   => [ \&snp_tag_handler_quote ],
     'todo'    => [ \&snp_tag_handler_todo ],

     'undef'   => [ \&snp_tag_handler_undef, 1 ],
     'define'  => [ \&snp_tag_handler_define, 1 ],
     'default' => [ \&snp_tag_handler_default, 1 ],
     'subst'   => [ \&snp_tag_handler_subst, 1 ],
     'final'   => [ \&snp_tag_handler_final, 1 ],

     'verbatim'=> [ \&snp_tag_handler_verbatim, 1 ],
     'snip'    => [ \&snp_tag_handler_snip, 1 ],
     'snap'    => [ \&snp_tag_handler_snip, 1 ],
     'read'    => [ \&snp_tag_handler_read ],
     'include' => [ \&snp_tag_handler_include ],

     'exec'    => [ \&snp_tag_handler_exec, 1 ],
     'shellq'  => [ \&snp_tag_handler_shellq, 1 ],
     'shell'   => [ \&snp_tag_handler_shell, 1 ],

     'skip'    => [ \&snp_tag_handler_skip, 1 ],

     'if'      => [ \&snp_tag_handler_if, 1 ],
     'elif'    => [ \&snp_tag_handler_elif, 1 ],
     'else'    => [ \&snp_tag_handler_else, 1 ],
     'fi'      => [ \&snp_tag_handler_fi, 1 ],

     # vvv  don't use eval/evalq, to keep everything portable
     'evalq'   => [ \&snp_tag_handler_evalq ],
     'eval'    => [ \&snp_tag_handler_eval ],
     # ^^^  don't use eval/evalq, to keep everything portable
     '*'       => [ \&snp_tag_handler_unknown ],
    };

my $snip_tag_handler_stack = [];

# |:here:|

sub snip_tag_handlers_new {
    return {};
}

sub snip_tag_get_handlers {
    return $snip_tag_handlers;
}

sub snip_tag_handlers_copy {
    my $old_handlers = shift || $snip_tag_handlers;
    my $new_handlers = snip_tag_handlers_new();
    foreach my $name (keys(%{$old_handlers})) {
        $new_handlers->{$name} = [ @{$old_handlers->{$name}} ];
    }
    return $new_handlers;
}

sub snips_handlers_set {
    my ( $new_handlers ) = @_;
    my $old_handlers = $snip_tag_handlers;
    if ( !defined ( $new_handlers )) {
        $new_handlers = snip_tag_handlers_copy();
    }
    $snip_tag_handlers = $new_handlers;
    return $old_handlers;
}

sub snips_handlers_push {
    my ( $new_handlers ) = @_;
    my $old_handlers = snips_handlers_set($new_handlers);
    push (@{$snip_tag_handler_stack}, $old_handlers);
    return $old_handlers;
}

# take one off the stack and discard
sub snips_handlers_drop {
    my $old_handlers = pop (@{$snip_tag_handler_stack});
    if ( !defined ( $old_handlers )) {
        $old_handlers = $snip_tag_handlers;
        snip_msg("severe internal error: snips_handlers_pop: snip_tag_handler_stack is empty\n");
        exit(1);                # |:debug:|
    }
    return $old_handlers;
}

sub snips_handlers_pop {
    return snips_handlers_set(snips_handlers_drop());
}

sub snip_tag_handler_copy {
    my ( $handler, $flag ) = @_;
    if (!$handler) {
        return undef;
    }
    $handler = [@{$handler}];
    if ( defined ( $flag )) {
        $handler->[1] = $flag;
    }
    return $handler;
}

sub snip_tag_get_handler {
    my ( $tag ) = @_;
    my $handler;
    if ( exists ( $snip_tag_handlers->{$tag} )) {
        $handler = $snip_tag_handlers->{$tag};
    }
    return $handler;
}

sub snip_tag_get_handler_copy {
    my ( $tag, $flag ) = @_;
    my $handler = snip_tag_get_handler($tag);
    return snip_tag_handler_copy($handler, $flag);
}

sub snip_tag_set_handler {
    my ( $tag, $handler ) = @_;
    my $old_handler = snip_tag_get_handler($tag);
    if ( !$handler) {
        delete($snip_tag_handlers->{$tag});
    } else {
        $snip_tag_handlers->{$tag} = $handler;
    }
    return $old_handler;
}

snip_tag_set_handler('for_snips', snip_tag_get_handler_copy('skip', 1));
snip_tag_set_handler('not_for_snips', snip_tag_get_handler_copy('rem', 1));

sub snip_tag_get_process_handler {
    my ( $tag, $process, $stage, $default ) = @_;
    my $handler;
    if ( exists ( $snip_tag_handlers->{$tag} )) {
        $handler = $snip_tag_handlers->{$tag};
    }
    if ( !$handler && $default
         && exists ( $snip_tag_handlers->{$default} )) {
        $handler = $snip_tag_handlers->{$default};
    }
    if ( $handler && ( $process || ($handler->[ 1 ] || 0) > $stage )) {
        return $handler;
    }
    my $msg = sprintf("[%s] prc[%d] stg[%d]",
                      $tag, $process, $stage);
    if ( $handler ) {
        $msg .= sprintf(" pri[%d]", $handler->[ 1 ] || 0);
        snip_msg ( " ".":DBG:  %-*s: %s\n", $dbg_fwid || 15, "handler reject", $msg || '' )
            if $DEBUG > 3;
    } else {
        snip_msg ( " ".":DBG:  %-*s: %s\n", $dbg_fwid || 15, "no handler",
                   $msg ) if $DEBUG> 3;
    }
    return;
}

# |||:sec:||| main processing engine
sub snips_process_line__ {
    my $snip_txt = shift;
    my $context = shift || snips_process_context();
    my $replace = $context->[ $snpc_ind_rpl ];
    my $process = $context->[ $snpc_ind_prc ];
    my $file_name = snips_context_filename($context);
    my $line_no = ++$context->[ $snpc_ind_lno ];
    my $start_seen = $context->[ $snpc_ind_sts ];
    my $done = $context->[ $snpc_ind_stp ];
    if ( $start_seen && !$done && $replace ) {
        $snip_txt = snip_replace ( $snip_txt );
        my @snt_lines = split(/[\r]*\n/, $snip_txt);
        if ($#snt_lines + 1 > 1) {
            # multi-line replacement, process inline
            my $multi_line_filename = sprintf('<multi-line at %s:%d>', $file_name, $line_no);
            snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
                       "replacement", $multi_line_filename || '' )
                if $DEBUG > 5;
            snips_process_feed_string($snip_txt, $context);
            return $context;
        }
    }

    my $stage = 1;
    # |:here:| snippet sections
    # |:info:| don't run any handlers in the end section
    #   no   `start`, no   `end`: stage = 1
    #   with `start`, no   `end`: stage = 0
    #   with `start`, with `end`: stage = 2
    #
    #   no   `start`, with `end`: stage = 3
    $stage -= 1 if $context->[$snpc_ind_sts];
    $stage += 2 if $context->[$snpc_ind_stp];
    my $match = 0;
    my $type;
    my $tag;
    my $targs;
    if ( $snip_txt =~ m,^(($comment_start_skip_rx) *|)($double_bar_rx)[|<][-:](sn[ia]?p)[-:][>|]($double_bar_rx)([ \t\r]*([^ \t\r\n]+)([ \t\r\n]+|$))?,so ) {
        $match = 1;
        $type = $4 || '';
        $tag = $7 || '';
        $targs = $' || '';
        $tag =~ s,[ \t\r\n]+$,,so;
        $tag =~ s,[ \t\r]*($comment_end_skip_rx).*$,,so;
        $tag = snips_tag_trans ( $tag );
        $targs =~ s,[ \t\r\n]+$,,so;
        $targs =~ s,[ \t\r]*($comment_end_skip_rx).*$,,so;
        snip_msg ( " ".":TGM:  %-*s: [%s] prc[%d] stg[%d] [%s]\n", $dbg_fwid || 15, "match tag",
                   $tag || '', $process, $stage, dbg_format_if_array($targs) || '' ) if $DEBUG> 3;
    }

    if ( $match ) {
        my $effective_process = $process && $stage == 0;
        my $handler = snip_tag_get_process_handler ( $tag, $effective_process, $stage, '*' );
        if ( $handler ) {
            my @result = &{$handler->[ 0 ]}( $context, $snip_txt, $targs, $tag, $type );
            $snip_txt = $result[ 0 ];
            $done = $result[ 1 ];
            if ( $done ) {
                return $context;
            }
        }
    }

    # trim line
    $snip_txt =~ s,[ \t]+(\r?\n?)$,$1,so;
    my $indent = $context->[$snpc_ind_ind];
    if ( $indent ) {
        my $is = sprintf('%-*s', $indent, '');
        $snip_txt =~ s,^,$is,mg;
        $snip_txt =~ s,[ \t]+$,,so;
    }
    if ( $done ) {
        $context->[ $snpc_ind_ftr ] .= $snip_txt;
    } else {
        $context->[ $snpc_ind_txt ] .= $snip_txt;
    }
    return $context;
}

sub snips_process_feed_string__ {
    my $snippet = shift;
    my $context = shift;

    if ( !defined ( $context )) {
        snips_msg("warning: snips_process_feed_string__ called without context.");
        return;
    }

    if ( !defined ( $snippet )) {
        $snippet = '';
    }

    my @lines = split ( /\r*\n/, $snippet."" ); # |:check:| preserve trailing blank lines
    my $cont_line = '';
    my $cont_lines = 0;
    my $in_cont = 0;
    # |:todo:| record lines verbatim for correct reprocessing
    foreach my $line ( @lines ) {
        if ( $in_cont ) {
            if ( $line =~ m,\\$,so ) {
                $cont_line .= $`;
                ++$cont_lines;
                next;
            }
            $line = $cont_line . $line;
            $in_cont = 0;
        } elsif ( $line =~ m,^((($comment_start_skip_rx) *|)\|<?[-:](sn[ia]?p)[-:]>?\|(.*))\\$,so ) {
            # also recognize single bar snippet tags for line continuation
            $cont_line = $1;
            $cont_lines = 1;
            $in_cont = 1;
            next;
        }

        snips_process_line__ ( $line."\n", $context );
        if ( $cont_lines ) {
            $context->[ $snpc_ind_lno ] += $cont_lines;
            $cont_lines = 0;
        }
        if ( $context->[ $snpc_ind_stp ]) {
            # stop replacing and processing in trailer |:check:| this seems redundant with the stage increase to 2
            $context->[ $snpc_ind_rpl ] = 0;
            $context->[ $snpc_ind_prc ] = 0;
            last;
        }
    }
    return;
}

sub snips_process_feed_string {
    my $snippet = shift;
    my $context = shift;
    my $at_line = shift || 0;

    if ( !defined ( $context )) {
        snips_msg("warning: snips_process_feed_string called without context.");
        return;
    }

    my $file_name = snips_context_filename($context);
    my $line_no = $context->[ $snpc_ind_lno ];
    my $multi_line_filename = sprintf('<multi-line at %s:%d>', $file_name, $line_no);
    $context->[ $snpc_ind_fil ] = $multi_line_filename;
    $context->[ $snpc_ind_lno ] = $at_line;
    $context = snips_process_feed_string__($snippet, $context);
    $context->[ $snpc_ind_fil ] = $file_name;
    $context->[ $snpc_ind_lno ] = $line_no;
    return;
}

sub snips_process_snippet__ {
    my $snippet = shift;
    my $context = shift || snips_process_context();
    $context->[ $snpc_ind_lno ] = 0;

    local ( $SNIPS_MARK ) = $SNIPS_MARK;
    my $is_processing = $context->[ $snpc_ind_prc ];
    if ( $context->[ $snpc_ind_prc ]) {
        # turn on marking, when processing
        $SNIPS_MARK |= $SNIPS_MARK_BIT_PRC;
    }

    snips_process_feed_string__($snippet, $context);

    # must replace, if not start seen.
    if ( $context->[ $snpc_ind_rpl ] && ! $context->[ $snpc_ind_sts ]) {
        $context->[ $snpc_ind_txt ] =
            snip_replace ( $context->[ $snpc_ind_txt ] );
    }

    # if not including, unescape snippet and clean up comments
    if ( !$context->[ $snpc_ind_inc ] ) {
        $context->[ $snpc_ind_txt ] =
            snip_unescape ( $context->[ $snpc_ind_txt ]);
        if ($is_processing) {
            # cleanup comments only, when processing
            $context->[ $snpc_ind_txt ] =
                snip_cleanup_comments ( $context->[ $snpc_ind_txt ]);
        }
    }

    # 0 000 => no marking, unless processing
    # 1 001 => mark tagged, if processing
    # 2 010 => mark untagged, if processing
    # 3 011 => mark both, if processing
    # 4 100 => forced marking
    # 5 101 => always mark tagged
    # 6 110 => always mark untagged
    # 7 111 => always mark both

    if ( $SNIPS_MARK & $SNIPS_MARK_BIT_PRC ) {
        # marking
        my $is_tagged = scalar(@{$context->[ $snpc_ind_mrk ]});
        my $accept = 0;
        if ( $is_tagged ) {
            if ( $SNIPS_MARK & $SNIPS_MARK_BIT_TAG ) {
                # marking tagged
                $accept = 1;
            }
        } else {
            if ( $SNIPS_MARK & $SNIPS_MARK_BIT_NTG ) {
                # marking untagged
                my $handler = snip_tag_get_process_handler ( 'mark', 1, 0 );
                if ( $handler ) {
                    &{$handler->[ 0 ]}( $context, '', '', 'mark', 'snap' );
                    $accept = 1;
                }
            }
        }

        if ( $accept ) {
            snip_msg ( "+ ACCEPT %s SNIPS_MARK %s"
                       #." BIT_TAG %s (%s) BIT_NTG %s (%s)"
                       ."\n",
                       $is_tagged ? "TAGGED  " : "untagged", binf ( $SNIPS_MARK, 3 ),
                       binf ( $SNIPS_MARK_BIT_TAG, 3 ), ($SNIPS_MARK & $SNIPS_MARK_BIT_TAG) ? 'y' : 'n',
                       binf ( $SNIPS_MARK_BIT_NTG, 3 ), ($SNIPS_MARK & $SNIPS_MARK_BIT_NTG) ? 'y' : 'n',
                     ) if $DEBUG > 4;
            my $beg = $context->[ $snpc_ind_mrk ]->[ 0 ] ;
            my $end = $context->[ $snpc_ind_mrk ]->[ 1 ];
            my $rpl = $context->[ $snpc_ind_mrk ]->[ 2 ];
            if ( $rpl ) {
                $beg = snip_replace ( $beg );
                $end = snip_replace ( $end );
            }
            $context->[ $snpc_ind_txt ] =
                (
                 $beg
                 .($opt_replace ? '@fempty@' : '')
                 .$context->[ $snpc_ind_txt ]
                 .$end
                 .($opt_replace ? '@fempty@' : '')
                );
        } else {
            snip_msg ( "- reject %s SNIPS_MARK %s"
                       #." BIT_TAG %s (%s) BIT_NTG %s (%s)"
                       ."\n",
                       $is_tagged ? "TAGGED  " : "untagged", binf ( $SNIPS_MARK, 3 ),
                       binf ( $SNIPS_MARK_BIT_TAG, 3 ), ($SNIPS_MARK & $SNIPS_MARK_BIT_TAG) ? 'y' : 'n',
                       binf ( $SNIPS_MARK_BIT_NTG, 3 ), ($SNIPS_MARK & $SNIPS_MARK_BIT_NTG) ? 'y' : 'n',
                     ) if $DEBUG > 4;
        }
    }
    return $context;
}

# single line cannot really handle start/stop tags or anything else ...
sub snips_process_line {
    die "error: snips_process_line has no meaningful application";
    # my $snip_txt = shift || '';
    # my $context = snips_process_context ( @_ );
    # snips_process_line__ ( $snip_txt, $context );
    # return $context->[ $snpc_ind_txt ];
}

sub snips_include_replacements_setup {
    my $snip_title;
    my $snip_title_call;
    my $snip_uuid;
    my $snip_uuid_call;

    $snip_title = snip_get_at_replacement('snip_title', undef);
    $snip_title_call = snip_get_at_replacement('snip_title_call', undef);

    # allow title handler to set it.
    snip_del_at_replacement('snip_title');
    snip_del_at_replacement('snip_title_incl');

    # pass on current snippet info
    if ( defined ( $snip_title )) {
        snip_set_at_replacement('snip_title_call', $snip_title);
    } else {
        snip_del_at_replacement('snip_title_call');
    }

    $snip_uuid = snip_get_at_replacement('snip_uuid', undef);
    $snip_uuid_call = snip_get_at_replacement('snip_uuid_call', undef);

    # allow uuid handler to set it.
    snip_del_at_replacement('snip_uuid');
    snip_del_at_replacement('snip_uuid_incl');

    # pass on current snippet info
    if ( defined ( $snip_uuid )) {
        snip_set_at_replacement('snip_uuid_call', $snip_uuid);
    } else {
        snip_del_at_replacement('snip_uuid_call');
    }
    return [ $snip_title, $snip_title_call, $snip_uuid, $snip_uuid_call];
}

sub snips_include_replacements_analysis {
    my $include_context = shift;
    my ( $snip_title, $snip_title_call, $snip_uuid, $snip_uuid_call ) = @{$include_context} ;

    if (snip_is_at_replacement_defined('snip_title')) {
        snip_set_at_replacement
            ('snip_title_incl',
             snip_get_at_replacement('snip_title'));
    } else {
        snip_del_at_replacement('snip_title_incl');
    }
    if ( defined ( $snip_title )) {
        snip_set_at_replacement('snip_title', $snip_title);
    } else {
        snip_del_at_replacement('snip_title');
    }
    if ( defined ( $snip_title_call )) {
        snip_set_at_replacement('snip_title_call', $snip_title_call);
    } else {
        snip_del_at_replacement('snip_title_call');
    }

    if (snip_is_at_replacement_defined('snip_uuid')) {
        my $snip_uuid_incl = snip_get_at_replacement('snip_uuid');
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "snip_uuid_incl", $snip_uuid_incl || '' )
            if $DEBUG > 6;
        snip_set_at_replacement('snip_uuid_incl', $snip_uuid_incl);
    } else {
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "snip_uuid_incl", '<<<delete>>>' || '' )
            if $DEBUG > 50;
        snip_del_at_replacement('snip_uuid_incl');
    }
    if ( defined ( $snip_uuid )) {
        snip_set_at_replacement('snip_uuid', $snip_uuid);
    } else {
        snip_del_at_replacement('snip_uuid');
    }
    if ( defined ( $snip_uuid_call )) {
        snip_set_at_replacement('snip_uuid_call', $snip_uuid_call);
    } else {
        snip_del_at_replacement('snip_uuid_call');
    }
}

# snips_process_snippet ( SNIPPET-STR[, FILENAME, [, REPLACE[, PROCESS[, INCLUDING[, FOR_SNIPS]]]]])
sub snips_process_snippet {
    my $snippet = shift;
    my $file = shift || '<string>';
    my $replace = shift;
    my $process = shift;
    my $including = shift || 0;
    my $for_snips = shift || 0;

    my $sv_for_snips;
    my $sv_not_for_snips;
    if ($for_snips) {
        $sv_for_snips = snip_tag_set_handler
            ('for_snips', snip_tag_get_handler_copy('rem', 1));
        $sv_not_for_snips = snip_tag_set_handler
            ('not_for_snips', snip_tag_get_handler_copy('skip', 1));
    }

    my $context = snips_process_context ( $replace, $process, $file );
    my $include_context;
    if ( $including ) {
        ++$context->[ $snpc_ind_inc ];
        $include_context = snips_include_replacements_setup();
    }
    snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15, 'context-string',
               snips_context_string($context)) if $DEBUG > 5; # |:debug:|
    snips_process_snippet__ ( $snippet, $context );
    if ( $including ) {
         --$context->[ $snpc_ind_inc ];
        snips_include_replacements_analysis($include_context);
     }

    if ($for_snips) {
        snip_tag_set_handler('for_snips', $sv_for_snips);
        snip_tag_set_handler('not_for_snips', $sv_not_for_snips);
    }

    if ( wantarray ) {
        snip_msgc ($context, "snips_process_snippet wantarray\n",
                   $context->[ $snpc_ind_fil ] || 'no_file',
                   $context->[ $snpc_ind_lno ]) if $DEBUG > 4;
        return @{$context};
    } else {
        return $context->[ $snpc_ind_txt ];
    }
}

sub snip_quote_file {
    my $filei = shift;
    $filei =~ s, ,\@\|snip_fn_space\@,sog;
    $filei =~ s,\t,\@\|snip_fn_tab\@,sog;
    $filei =~ s,\r,\@\|snip_fn_cr\@,sog;
    $filei =~ s,\n,\@\|snip_fn_nl\@,sog;
    return $filei;
}

# snips_read_snippet ( FILE[, REPLACE[, PROCESS[, INCLUDING[, FOR_SNIPS ]]]])
sub snips_read_snippet {
    my $file = shift;
    my $replace = shift;
    my $process = shift;
    my $including = shift || 0;
    my $for_snips = shift || 0;

    my $sv_for_snips;
    my $sv_not_for_snips;
    if ($for_snips) {
        $sv_for_snips = snip_tag_set_handler
            ('for_snips', snip_tag_get_handler_copy('rem', 1));
        $sv_not_for_snips = snip_tag_set_handler
            ('not_for_snips', snip_tag_get_handler_copy('skip', 1));
    }

    my $context = snips_process_context( $replace, $process );
    if ( $file eq '-' ) {
        $context->[ $snpc_ind_fil ] = '<stdin>';
    } else {
        $context->[ $snpc_ind_fil ] = $file;
    }
    my $include_context;
    if ( $including ) {
        ++$context->[ $snpc_ind_inc ];
        $include_context = snips_include_replacements_setup();
    }
    if ( !defined ( $context )) {
        printf STDERR ( "%s\n", '|||:OOPS:|||' );
        exit ( 1 );
    }
    #snip_msg ( "%s\n", Data::Dumper->Dump( [ $context ], [qw ( $context )]));
    snip_msg ( " :CTX:  %-*s: [%s]\n", $dbg_fwid || 15, 'context-read',
               snips_context_string($context)) if $DEBUG > 5; # |:debug:|
    my $snippet = snips_read_file ( $file );

    my $sv_self = snip_get_at_replacement('snip_self', '/dev/null');
    my $sv_selfi = snip_get_at_replacement('snip_selfi', "/dev/null");
    my $sv_selfq = snip_get_at_replacement('snip_selfq', "'/dev/null'");

    my $sv_self_dir = snip_get_at_replacement('snip_self_dir', '.');
    my $sv_self_diri = snip_get_at_replacement('snip_self_diri', ".");
    my $sv_self_dirq = snip_get_at_replacement('snip_self_dirq', "'.'");

    my $sv_self_base = snip_get_at_replacement('snip_self_base', '');
    my $sv_self_basei = snip_get_at_replacement('snip_self_basei', "");
    my $sv_self_baseq = snip_get_at_replacement('snip_self_baseq', "''");

    my $snip_self = $file;
    $snip_self =~ s,/+$,,so;
    my $snip_self_dir = $snip_self;
    $snip_self_dir =~ s,(.*)/[^/]*$,$1,so;
    if ( $snip_self_dir eq $snip_self) {
        $snip_self_dir = '.';
    }
    my $snip_self_base = $snip_self;
    $snip_self_base =~ s,.*/,,so;
    snip_set_at_replacement('snip_self', $snip_self);
    snip_set_at_replacement('snip_self_dir', $snip_self_dir);
    snip_set_at_replacement('snip_self_base', $snip_self_base);

    my $snip_selfi = snip_quote_file($snip_self);
    my $snip_self_diri = snip_quote_file($snip_self_dir);
    my $snip_self_basei = snip_quote_file($snip_self_base);
    snip_set_at_replacement('snip_selfi', $snip_selfi);
    snip_set_at_replacement('snip_self_diri', $snip_self_diri);
    snip_set_at_replacement('snip_self_basei', $snip_self_basei);

    my $snip_selfq = "'".sq($snip_self)."'";
    my $snip_self_dirq = "'".sq($snip_self_dir)."'";
    my $snip_self_baseq = "'".sq($snip_self_base)."'";
    snip_set_at_replacement('snip_selfq', $snip_selfq);
    snip_set_at_replacement('snip_self_dirq', $snip_self_dirq);
    snip_set_at_replacement('snip_self_baseq', $snip_self_baseq);

    snips_process_snippet__ ( $snippet, $context );

    snip_set_at_replacement('snip_self', $sv_self);
    snip_set_at_replacement('snip_selfi', $sv_selfi);
    snip_set_at_replacement('snip_selfq', $sv_selfq);

    snip_set_at_replacement('snip_self_dir', $sv_self_dir);
    snip_set_at_replacement('snip_self_diri', $sv_self_diri);
    snip_set_at_replacement('snip_self_dirq', $sv_self_dirq);

    snip_set_at_replacement('snip_self_base', $sv_self_base);
    snip_set_at_replacement('snip_self_basei', $sv_self_basei);
    snip_set_at_replacement('snip_self_baseq', $sv_self_baseq);

    if ( $including ) {
        --$context->[ $snpc_ind_inc ];
        snips_include_replacements_analysis($include_context);
    }

    if ($for_snips) {
        snip_tag_set_handler('for_snips', $sv_for_snips);
        snip_tag_set_handler('not_for_snips', $sv_not_for_snips);
    }

    if ( wantarray ) {
        snip_msgc ($context, "snips_read_snippet wantarray\n",
                   $context->[ $snpc_ind_fil ] || 'no_file',
                   $context->[ $snpc_ind_lno ]) if $DEBUG > 4;
        return @{$context};
    } else {
        return $context->[ $snpc_ind_txt ];
    }
}

# --------------------------------------------------
# |||:sec:||| MAIN
# --------------------------------------------------

# |||:sec:||| find and process first snip_setup file
sub process_snips_setup {
    my $snips_setup = "snip_setup";
    my @rc_search_dirs = (reverse(@snips_path_dirs), '.');
    foreach my $dir (@rc_search_dirs) {
        my $rc = $dir . '/' . $snips_setup;
        if ( -r $rc ) {
            snip_msg ( "--------------------------------------------------\n")
                if $DEBUG > 5;
            snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
                       $snips_setup, $rc) if $DEBUG > 0;
            snips_read_snippet( $rc, 1, 1, 1, 1 );
            last;
        }
    }
}
process_snips_setup();

# |||:sec:||| find and evaluate .snips.rc resource files
sub process_snips_rcs {
    my $snips_rc = ".snips.rc";
    my @rc_search_dirs = (reverse(@snips_path_dirs), '.');
    foreach my $dir (@rc_search_dirs) {
        my $rc = $dir . '/' . $snips_rc;
        if ( -r $rc ) {
            snip_msg ( "--------------------------------------------------\n")
                if $DEBUG > 5;
            snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
                       $snips_rc, $rc) if $DEBUG > 0;
            # |:todo:| remove obsolete eval interface
            do $rc;
            # process rc as snippets
            snips_read_snippet( $rc, 1, 1, 1, 1 );
        } else {
            snip_msg ( " :DBG:  %-*s: [%s]\n", $dbg_fwid || 15,
                       $snips_rc, 'not found in ' .$dir) if $DEBUG > 5;
        }
    }
}
process_snips_rcs();

# # clear title
# if ( $opt_title ) {
#     snip_set_at_replacement('title', $opt_title);
#     snip_set_at_replacement('snip_title_last', $opt_title);
# } else {
#     snip_del_at_replacement('title');
# }

snip_msg ( "--------------------------------------------------\n")
    if $DEBUG > 5;

# |||:sec:||| --work
if ( $opt_work ) {
    my $snip_txt = "'".join ( "' '", map { sq ( $_ ); } @ARGV )."'";
    mkdir ( $SNIPS_DIR, 0777 ) if ! -d $SNIPS_DIR;
    chdir ( $SNIPS_DIR ) || exit ( 1 );
    my $work_file = 'WORK';
    if ( -r 'WORK_DONE' ) {
        $work_file = 'WORK_DONE';
    }
    snip_msg ( "%s\n", sq ( $SNIPS_DIR.'/'.$work_file )) if $VERBOSE;
    system ( "work ".$snip_txt );
    exit ( 0 );
}

# |||:sec:||| store/list/cat/new
if (( !$opt_cat && !$opt_new && $VERBOSE ) || $DEBUG ) {
    snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_PATH", $SNIPS_PATH || '' );
    snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_DIR", $SNIPS_DIR || '' );
    snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_MODE", $SNIPS_MODE || '' );
    snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_CAT", $SNIPS_CAT || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_MODE_IS_DEFAULT", $SNIPS_MODE_IS_DEFAULT || '' )
        if $DEBUG;
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_CAT_IS_DEFAULT", $SNIPS_CAT_IS_DEFAULT || '' )
        if $DEBUG;
    if ( $DEBUG > 5 ) {
        my @user_replacement_keys = sort(keys(%{$SNIPS_REPLACEMENTS_USER}));
        if ( $DEBUG > 5) { # |:todo:| move to appropriate location
            foreach my $key (@user_replacement_keys) {
                my $value = $SNIPS_REPLACEMENTS_USER->{$key};
                snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, 'user '.$key, $value || '' );
            }
        }
    }
}

my ( $date, $time ) = split ( / /, $time_stamp );
my ( $year, $month, $day ) = split ( /-/, $date );
my ( $hours, $minutes, $seconds ) = split ( /:/, $time );
snip_set_at_replacement ( sts => $stime );
snip_set_at_replacement ( dts => $time_stamp );
snip_set_at_replacement ( date => $date );
snip_set_at_replacement ( time => $time );
snip_set_at_replacement ( year => $year );
snip_set_at_replacement ( month => $month );
snip_set_at_replacement ( day => $day );
snip_set_at_replacement ( hours => $hours );
snip_set_at_replacement ( minutes => $minutes );
snip_set_at_replacement ( seconds => $seconds );

# |||:sec:||| --store
if ( $opt_store || $opt_append ) {
    my $snip_txt = join ( ' ', @ARGV );
    my $snip_tag = '';
    my $name_guess_pfx = 'txt';
    my $name_guess = '';
    if ( $opt_name && !$snip_txt ) {
        # single argument => no filename, just text
        if ( $opt_name ne '-' ) {
            $snip_txt = $opt_name;
            $opt_name = '';
        } elsif ( -r $opt_name ) {
            $snip_txt = $opt_name;
            $opt_name = '';
        } elsif ( $opt_name =~ m,^([^/:]+)://,so ) {
            $snip_txt = $opt_name;
            $opt_name = '';
        }
    }

    if ( !$snip_txt || $snip_txt eq '-' ) {
        # no argument, or filename == stdin
        $name_guess_pfx = 'pipe';
        shift ( @ARGV );
        $snip_txt = '';
        while (<>) {
            $snip_txt .= $_;
        }
    } elsif ( $snip_txt !~ m,[\r\n],so ) {
        # single line text
        if ( -r $snip_txt ) {
            # readable file
            my $file = $snip_txt;
            $snip_tag = $file;
            $name_guess_pfx = 'file';
            $name_guess = $file;
            $name_guess =~ s,.*/,,so;
            $name_guess =~ s,^ +,,so;
            $name_guess =~ s, +$,,so;
            $name_guess =~ s, ,-,sog;
            $name_guess =~ s,--+,-,sog;
            $name_guess =~ s,-+$,,sog;
            $snip_txt = '';
            if ( open ( FILE, '<'.$file )) {
                while (<FILE>) {
                    $snip_txt .= $_;
                }
                close ( FILE );
            }
        } elsif ( $snip_txt =~ m,^([^/:]+)://,so ) {
            # URL
            my $proto = lc ( $1 );
            my $url = $snip_txt;
            $snip_tag = $url;
            $name_guess_pfx = 'url';
            $name_guess = $url;
            $name_guess =~ s,^([^/:]+)://,,so;
            $name_guess =~ s,^ +,,so;
            $name_guess =~ s, +$,,so;
            $name_guess =~ s,[^0-9A-Za-z],-,sog;
            $name_guess =~ s,--+,-,sog;
            $name_guess = substr ( $name_guess, 0, 20 );
            $name_guess =~ s,-+$,,sog;
            $snip_txt = '';
            if ( $opt_mode ne 'html' && ( $proto eq 'http' || $proto eq 'https' )) {
                my $cmd = sprintf ( "w3m -cols 150 -dump '%s'", sq ( $url ));
                $snip_txt = `$cmd`;
            } else {
                my $cmd = sprintf ( "wget -q -O - '%s'", sq ( $url ));
                $snip_txt = `$cmd`;
            }
        }
    }

    $snip_txt =~ s,[ \t\r\n]+$,,so;

    my $opt_name_guessed = '';

    if ($SNIPS_CAT && ( !$SNIPS_CAT_IS_DEFAULT || !$SNIPS_MODE_IS_DEFAULT || !$name_guess_pfx)) {
        $name_guess_pfx = $SNIPS_CAT;
    }

    if ( !$opt_name ) {
        if ( !$name_guess || $opt_title ) {
            if ( $opt_title ) {
                $name_guess = $opt_title;
            } else {
                $name_guess = $snip_txt;
            }
            $name_guess =~ s,^[^0-9A-Za-z]+,,so;
            $name_guess =~ s,\n.*,,so;
            $name_guess =~ s,[ \t\r]+$,,so;
            $name_guess =~ s,[^0-9A-Za-z],-,sog;
            $name_guess =~ s,--+,-,sog;
            $name_guess = substr ( $name_guess, 0, 20 );
            $name_guess =~ s,-+$,,sog;
        }
        $opt_name_guessed = $name_guess_pfx.'_'.strftime( "%Y%m%d-%H%M%S", localtime ( time())).( $name_guess ? '_' : '' ).$name_guess;
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_name_guessed",
                   $opt_name_guessed || '' ) if $DEBUG;
    } else {
        if ( $opt_name ne '-') {
            my $cat_pfx_part = $opt_name;
            $cat_pfx_part =~ s,[.].*,,so;
            if ( $cat_pfx_part !~ m,_,so ) {
                # no category defined
                $opt_name = $name_guess_pfx.'_'.$opt_name;
            } else {
                $name_guess_pfx = $cat_pfx_part;
                $name_guess_pfx =~ s,_.*,,so;
            }
        }
    }

    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "name_guess_pfx(i)", $name_guess_pfx || '' )
        if $DEBUG > 5;

    my $mode;
    if ( $SNIPS_MODE_IS_DEFAULT && $name_guess_pfx ) {
        $mode = snip_set_default_mode($name_guess_pfx);
    } else {
        $mode = snip_set_default_mode();
    }

    if ( $VERBOSE ) {
        snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_MODE(eff)", $SNIPS_MODE || '' );
        snip_msg ( " ".":INF:  %-*s: [%s]\n", $dbg_fwid || 15, "SNIPS_CAT(eff)", $SNIPS_CAT || '' );
    }

    if ( !$opt_name ) {
        $opt_name = $opt_name_guessed;
    }

    if ( !$snip_txt ) {
        snip_msg ( "warning: storing empty snippet\n" ) if $VERBOSE;
    }

    my $snip_file;
    my $hdr;
    my $ftr;
    # :struct: snips_header_footer SNIPS header/footer
    # i use header/footer
    # t read header/footer from snippet
    # -
    # i forced store AND no header/footer yet
    # t read snippet header/footer from file
    # -
    # i NO header/footer
    # t use default header/footer
    # :struct:

    if ( $opt_use_hdr || $opt_use_ftr ) {
        # just split it
        # ||:todo:|| use text chunk stack a la qp-ascii-render.pl
        snip_msg ( " ".":HDR:  %-*s: hdr[%d] ftr[%d]]\n", $dbg_fwid || 15,
                   "opt_use_hdr/ftr", $opt_use_hdr || 0, $opt_use_ftr || 0 )
            if $DEBUG;
        my @context = snips_process_snippet ( $snip_txt, '<get-hdr-ftr>', 0, 0, 1 );
        if ( $opt_use_hdr ) {
            $hdr = $context[ $snpc_ind_hdr ];
            snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, "opt hdr", dbg_flatten_str($hdr || ''))
                if $DEBUG;
        }
        $snip_txt = $context[ $snpc_ind_txt ];
        $snip_txt =~ s,\n$,,so;
        if ( $opt_use_ftr ) {
            $ftr = $context[ $snpc_ind_ftr ];
            snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, "opt ftr", dbg_flatten_str($ftr || ''))
                if $DEBUG;
        }
    }

    local ( *FILE );
    if ( $opt_name eq '-' ) {
        my $rep_filename = snip_get_at_replacement ( 'filename' );
        if ( $rep_filename ) {
            $snip_file = $rep_filename;
        } else {
            $snip_file = '<stdout>';
        }
        *FILE = *STDOUT;
    } else {
        $snip_file = $SNIPS_DIR.'/'.$opt_name;
        if ( $opt_append ) {
            $opt_force = 1;
        }
        if ( -r $snip_file ) {
            if ( $opt_force ) {
                local ( $VERBOSE ) = 0;
                # ||:todo:|| use text chunk stack a la qp-ascii-render.pl
                my @context = snips_read_snippet ( $snip_file, 0, 0 );
                if ( !$hdr ) {
                    $hdr = $context[ $snpc_ind_hdr ];
                    snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, "snippet hdr", dbg_flatten_str($hdr || ''))
                        if $DEBUG;
                }
                if ( !$ftr ) {
                    $ftr = $context[ $snpc_ind_ftr ];
                    snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, "snippet ftr", dbg_flatten_str($ftr || ''))
                        if $DEBUG;
                }
                if ( $opt_append ) {
                    my $txt = $context[ $snpc_ind_txt ];
                    $snip_txt = $txt . $snip_txt;
                }
            } else {
                snip_msg ( "error: snippet `%s` exists\n", $snip_file );
                exit ( 1 );
            }
        }
        mkdir ( $SNIPS_DIR, 0777 ) if ! -d $SNIPS_DIR;
        if ( !open ( FILE, '>'.$snip_file )) {
            snip_msg ( "error: writing snippet `%s` failed\n", $snip_file );
            exit ( 1 );
        }
        if ( !$SNIPS_MODE && !$SNIPS_CAT ) {
            $SNIPS_CAT = $opt_name;
            $SNIPS_CAT =~ s,_.*,,so;
        }
    }
    my $hf_file = $snip_file;
    $hf_file =~ s,.*/,,so;
    my $hf_base = $hf_file;
    $hf_base =~ s,[.][^.]*$,,so;
    snip_set_at_replacement('filename', $hf_file );
    snip_set_at_replacement('filebase', $hf_base );
    if ( !$hdr ) {
        snips_ensure_snippets_collected( @snips_path_dirs );
        $hdr = snip_header_for_mode( $mode );
        snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, sprintf("mode hdr (%s)", $mode), dbg_flatten_str($hdr || ''))
            if $DEBUG;
    }
    if ( !$ftr ) {
        snips_ensure_snippets_collected( @snips_path_dirs );
        $ftr = snip_footer_for_mode( $mode );
        snip_msg ( " ".":HDR:  %-*s: [%s]\n", $dbg_fwid || 15, sprintf("mode ftr (%s)", $mode), dbg_flatten_str($ftr || ''))
            if $DEBUG;
    }

    if ( !$opt_literal ) {
        $snip_txt = snip_escape ( $snip_txt );
    }

    my $snippet = '';
    $snippet .= $hdr;
    $snippet .= snip_tag_start ( $snip_tag );
    if ( $snip_txt ) {
        $snippet .=  $snip_txt."\n";
    }
    $snippet .=  snip_tag_stop();
    $snippet .=  $ftr;

    # |:todo:| final output hook
    if ($SNIPS_MODE eq 'rst') {
	$snippet =~ s,^[.][.] ?[|][|]<-,.. \\||<-,mog;
    }

    print FILE $snippet;

    close ( FILE ) if $opt_name ne '-';
    snip_msg ( "snippet `%s` stored\n", $snip_file ) if $VERBOSE;
    exit ( 0 );
}

# |||:sec:||| setup list/cat
snips_collect_snippets( @snips_path_dirs );
# snip_msg ( "%s\n", Data::Dumper->Dump( [ $SNIPS_BY_CAT ], [qw ( $SNIPS_BY_CAT )]));
my @categories = sort ( keys ( %{$SNIPS_BY_CAT}));

if ( $DEBUG ) {
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_ignore_cat_rx", $opt_ignore_cat_rx || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_accept_cat_rx", $opt_accept_cat_rx || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_name_rx", $opt_name_rx || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "categories", join ( ', ', @categories ));
}

# |||:sec:||| --list
if ( $opt_list ) {
    if ( $prog_name =~ m,^sn..?$, && -l $0 ) {
        $prog_name = readlink ( $0 );
        $prog_name =~ s,.*/,,so;
    }
    if ( $opt_as_includes ) {
        $SNIPS_DEF_MODE = 'generic';
        $opt_accept_cat_seen = 1;
        $SNIPS_MODE = snip_set_default_mode();
        my $snips_cmd = $SNIPS_COMMENT_START_SEP.snip_ptagf ( "include ",  );
        snips_iterate ( \&snips_cb_list_as_includes, [ $snips_cmd, $SNIPS_COMMENT_END_SEP ]);
    } else {
        my @user_replacement_keys = sort(keys(%{$SNIPS_REPLACEMENTS_USER}));
        my $snips_cmd =
            sprintf ( "%s" ."%s" ."%s" ."%s" ."%s" ."%s" ."%s" ."%s" ."%s" ."%s"
                      ." --cat ",
                      $prog_name,
                      $VERBOSE > 1 ? ' --verbose' : '',
                      $opt_replace ? ' --replace' : '',
                      $opt_process ? ' --process' : '',
                      $opt_accept_cat_seen ?
                      sprintf ( " --accept-cat '%s'", sq ( $opt_accept_cat_rx )) : '',
                      $opt_ignore_cat_seen ?
                      sprintf ( " --ignore-cat '%s'", sq ( $opt_ignore_cat_rx )) : '',
                      sprintf ( " --mode '%s'", $opt_mode_seen ? sq ( $opt_mode ) : '@mode@'),
                      $opt_mode_main_only ? ' --main-only' : '',
                      $opt_dir_seen ?
                      join ( '', map { sprintf ( " --dir '%s'", sq ( $_ )) } @opt_dirs ) : '',
                      join ( '', map { my $key = $_;
                                       my @nkeys = snip_normalize_at_key( $key );
                                       my $nkey = $nkeys[ 1 ];
                                       my $res = sprintf ( " --key '%s'", sq( $nkey ));
                                       my $value = $SNIPS_REPLACEMENTS_USER->{$key};
                                       if ( defined ( $value )) {
                                           $res .= sprintf ( " --value '%s'", sq ( $value ));
                                       }
                                       $res;
                                   } @user_replacement_keys),
                    );
        my $mode_rep = snip_get_at_replacement( 'mode' );
        my $sv_replacements = snip_replacements_save( {} );
        snip_set_at_replacement( 'mode', $mode_rep );
        snips_iterate ( \&snips_cb_list, $snips_cmd );
        snip_replacements_restore($sv_replacements);
    }
    exit ( 0 );
}

my $grep_next_is_e = 0;
my $grep_opt_done = 0;
sub grep_arg_quote {
    my $opt = shift;
    if ( $grep_opt_done ) {
        return " '".sq( $opt )."'";
    }
    if ( $grep_next_is_e ) {
        $grep_next_is_e = 0;
        return " '".sq( $opt )."'";
    }
    if ( m/^--as/ ) {
        $opt_as_includes = 1;
        return '';
    }
    if ( $opt =~ m/^(-e|--reg)/) {
        $grep_next_is_e = 1;
        return ' '.$opt;
    }
    if ( $opt eq '--' ) {
        $grep_opt_done = 1;
        return ' '.$opt;
    }
    return " '".sq( $opt )."'";
}

# |||:sec:||| --grep
if ( $opt_grep ) {
    $opt_grep_opts = join ( '', map {
        grep_arg_quote ( $_ );
    } @opt_grep_opts );
    if ( !$opt_grep_opts ) {
        snip_msg ( "warning: empty grep options\n" ) if $VERBOSE;
        exit ( 0 );
    }
    if ( $opt_as_includes ) {
        $opt_grep_opts = ' -l'.$opt_grep_opts;
    }
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_grep_opts", $opt_grep_opts || '' ) if $DEBUG;
    if ( $prog_name =~ m,^sn..?$, && -l $0 ) {
        $prog_name = readlink ( $0 );
        $prog_name =~ s,.*/,,so;
    }
    if ( $opt_as_includes ) {
        $SNIPS_DEF_MODE = 'generic';
        $opt_accept_cat_seen = 1;
        $SNIPS_MODE = snip_set_default_mode();
        my $snips_cmd = sprintf ( "%s|\:snap:| include ", $SNIPS_COMMENT_START_SEP );
        snips_iterate ( \&snips_cb_grep_as_includes, [ $snips_cmd, $SNIPS_COMMENT_END_SEP ]);
    } else {
        my $snips_cmd = '# not used';
        snips_iterate ( \&snips_cb_grep, $snips_cmd );
    }
    exit ( 0 );
}

# |||:sec:||| setup cat/new
{
    # # clear title
    # if ( $opt_title ) {
    #     snip_set_at_replacement('title', $opt_title);
    #     snip_set_at_replacement('snip_title_last', $opt_title);
    # } else {
    #     snip_del_at_replacement('title');
    # }

    # more deduced replacements
    my $fnr = snip_get_at_replacement ( 'filename' );
    if ( $fnr ) {
        my $fbr = snip_get_at_replacement ( 'filebase' );
        if ( !$fbr ) {
            $fbr = $fnr;
            $fbr =~ s,[.][^.]*$,,so;
            snip_set_at_replacement ( 'filebase', $fbr );
        }
    }
}

if ( $DEBUG ) {
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "comment_start_skip_rx", $comment_start_skip_rx || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "comment_end_skip_rx", $comment_end_skip_rx || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_process", $opt_process || '' );
    snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "opt_replace", $opt_replace || '' );
    if ( $opt_replace && $DEBUG > 4 ) {
        foreach my $rkey ( sort ( keys %{$SNIPS_REPLACEMENTS})) {
            my $rval = $SNIPS_REPLACEMENTS->{$rkey};
            snip_msg ( " %-26s => [%s]\n", "[".$rkey."]", dbg_flatten_str($rval));
        }
        snip_msg ( " ".":DBG:  %-*s: [%s]\n", $dbg_fwid || 15, "snip_replace_rx",
                   snip_fmt_rx ( snip_replace_rx()) || '' );
    }
}

# |||:sec:||| --cat
if ( $opt_cat ) {
    # Make sure, that all appropriate files are found ...
    my $files;
    if ( $opt_name_rx eq '-' ) {
        # special snippet name
        # if next argument is text, it is used as snippet text
        # otherwise, the snippet is read from standard input.
        $files = [ $opt_name_rx ];
        if ( $opt_temp_snippet ) {
            my $snip_txt = snips_process_snippet ( $opt_temp_snippet, '<temp-snippet>' );
	    # |:todo:| final output hook
	    if ($SNIPS_MODE eq 'rst') {
		$snip_txt =~ s,^[.][.] ?[|][|]<-,.. \\||<-,mog;
	    }
            print STDOUT $snip_txt;
            exit ( 0 );
        }
    } elsif ( -r $opt_name_rx ) {
        $files = [ $opt_name_rx ];
    } else {
        if ($SNIPS_CAT_IS_DEFAULT) {
            $opt_accept_cat_rx = '.*';
        }
        $files = snips_find_file ( 0, $opt_all, $opt_name_rx );
    }

    if ( $#{$files} < 0 ) {
        snip_msg ( "warning: no snippet matching `%s` found\n", $opt_name_rx ) if $VERBOSE;
        exit ( 1 );
    } else {
        # ... before setting a mode that may prevent some files to be acepted.
        # However, a default mode is needed to replace comments and such.
        snip_set_default_mode();
        foreach my $file ( @{$files} ) {
            if ($SNIPS_MODE_IS_DEFAULT) {
                my $cat_pfx_part = $file;
                $cat_pfx_part =~ s,.*/,,so;
                $cat_pfx_part =~ s,[.].*,,so;
                if ( $cat_pfx_part !~ m,_,so ) {
                    snip_set_default_mode();
                } else {
                    snip_set_mode($cat_pfx_part);
                }
            }
            my $snip_txt = snips_read_snippet ( $file );
            if ( $opt_replace ) {
                # final replacement
                $snip_txt = snip_replace_final($snip_txt);
            }
	    # |:todo:| final output hook
	    if ($SNIPS_MODE eq 'rst') {
		$snip_txt =~ s,^[.][.] ?[|][|]<-,.. \\||<-,mog;
	    }
            print STDOUT $snip_txt;
        }
    }
    exit ( 0 );
}

# |||:sec:||| --new
if ( $opt_new ) {
    $opt_name_rx = '^('.$opt_name.')$';
    my $files = snips_find_file ( 0, 0, $opt_name_rx );
    if ( $#{$files} < 0 ) {
        snip_msg ( "warning: no snippet matching `%s` found\n", $opt_name_rx ) if $VERBOSE;
        exit ( 1 );
    } else {
        local ( *OUT );
        if ( $opt_filename ne '-' ) {
            if ( !$opt_force && -r $opt_filename ) {
                snip_msg ( "error: output file `%s` exists\n", $opt_filename );
                exit ( 1 );
            }
            open ( OUT, '>'.$opt_filename );
        } else {
            *OUT = *STDOUT;
        }
        foreach my $file ( @{$files} ) {
            my $snip_txt = snips_read_snippet ( $file );
            if ( $opt_replace ) {
                # final replacement
                $snip_txt = snip_replace_final($snip_txt);
            }
	    # |:todo:| final output hook
	    if ($SNIPS_MODE eq 'rst') {
		$snip_txt =~ s,^[.][.] ?[|][|]<-,.. \\||<-,mog;
	    }
            print OUT $snip_txt;
        }
        close ( OUT ) if $opt_filename ne '-';
    }
    exit ( 0 );
}

__END__ # |:here:|
#
# :ide-menu: Emacs IDE Main Menu - Buffer @BUFFER@
# . M-x `eIDE-menu' (eIDE-menu "z")

# :ide: Find related classes
# . (shell-command (concat "find -name '*.pm' | sort | grep -v '^\\./" (file-name-nondirectory (buffer-file-name)) "$' | sed 's,^\\./,,;s,/,::,g;s,\\.pm,,;s,^,#  - L<,;s,$,>,'"))

# :ide: Extract API:
# . (shell-command (concat "grep -e '^#[^.]*\\(VOID\\| = \\).*(.*)' " (buffer-file-name) " | sed 's,^#!,# ,;s,\\(.*VOID\\|.* =\\) *\\([0-9A-Za-z_]*\\),\\1 L<#\\2>,'"))

# :ide: Extract main API:
# . (shell-command (concat "grep -e '^#!' " (buffer-file-name) " | sed 's,^#!,# ,;s,\\(.*VOID\\|.* =\\) *\\([0-9A-Za-z_]*\\),\\1 L<#\\2>,'"))

# :ide: Show main API
# . (occur "^#!" nil)

# :ide: Show SUB protos
# . (occur "^#[^.\n]*\\(VOID\\| = \\).*(.*)" nil)

# :ide: Show SUBS
# . (occur "^sub[ \t]" nil)

# :ide: +=#=+
# . Utilities ()

# :ide: TEXT: Insert `# ----- ...' (before line)
# . (let ((f (concat "# --------------------------------------------------\n# " (symbol-tag-make-tag "here") "\n")) (s "") b) (save-excursion (beginning-of-line) (setq b (point)) (insert-before-markers (format f (pp-to-string s))) (indent-region b (point) nil)))

# :ide: +=#=+
# . Text ()

# :ide: TEXT: Insert `headline' (w/prompt before line, quoted)
# . (let ((f "# --------------------\nheadline ( %s );\n") (s (read-from-minibuffer "Headline: ")) b) (save-excursion (beginning-of-line) (setq b (point)) (insert-before-markers (format f (pp-to-string s))) (indent-region b (point) nil)))

# :ide: TEXT: Insert `show_objs' (w/prompt at point)
# . (let ((f "%sshow_objs ( '%s' );\n") (r (read-from-minibuffer "Assign to: " nil nil nil nil "$OBJ")) (s (read-from-minibuffer "Expression: " (quote ( "$OBJ" . 0 )))) b) (or (equal r "") (setq r (concat r " = "))) (insert (format f r s)))

# :ide: TEXT: Insert `show_str' (w/prompt at point)
# . (let ((f "%sshow_str ( '%s' );\n") (r (read-from-minibuffer "Assign to: " nil nil nil nil "$ref")) (s (read-from-minibuffer "Expression: " (quote ( "$OBJ" . 0 )))) b) (or (equal r "") (setq r (concat r " = "))) (insert (format f r s)))

# :ide: TEXT: Insert `show_exp' (w/prompt at point)
# . (let ((f "%sshow_exp ( '%s' );\n") (r (read-from-minibuffer "Assign to: " nil nil nil nil "$str")) (s (read-from-minibuffer "Expression: " (quote ( "$OBJ->()" . 7 )))) b) (or (equal r "") (setq r (concat r " = "))) (insert (format f r s)))

# :ide: TEXT: Insert `hl' (w/prompt before line, quoted)
# . (let ((f "# --------------------\nhl ( %s );\n") (s (read-from-minibuffer "Headline: ")) b) (save-excursion (beginning-of-line) (setq b (point)) (insert-before-markers (format f (pp-to-string s))) (indent-region b (point) nil)))

# :ide: +=#=+
# . Test Utilities ()

# :ide: COMPILE: Read args
# . (let ((args (read-from-minibuffer "Args: "))) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --help
# . (let ((args "--help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --install
# . (let ((args "--install")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --dist
# . (let ((args "--dist")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: Standard
# . (let ((args "")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: SNIPS_DIR=somewhere/out/there .. b
# . (let ((args "b")) (save-buffer) (compile (concat "SNIPS_DIR='somewhere/out/there' perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --accept-cat sh --list
# . (let ((args "--accept-cat sh --list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --accept-cat pl --list
# . (let ((args "--accept-cat pl --list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --accept-cat pl --list=o
# . (let ((args "--accept-cat pl --list=o")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --debug --mode html --store - http://www.simul.de
# . (let ((args "--debug --mode html --store - http://www.simul.de")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --mode text --list
# . (let ((args "--mode text --list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: CMD: RAW       "snippets.pl --key '@file@' --val 'file_replaced' --no-replace --cat '^snt_hello-world$'
# . (shell-command "snippets.pl --key '@file@' --val 'file_replaced' --no-replace --cat '^snt_hello-world$'" nil nil)

# :ide: CMD: PROCESSED "snippets.pl --key '@file@' --val 'file_replaced' --no-replace --process --cat '^snt_hello-world$'
# . (shell-command "snippets.pl --key '@file@' --val 'file_replaced' --no-replace --process --cat '^snt_hello-world$'" nil nil)

# :ide: CMD: REPLACED  "snippets.pl --key '@file@' --val 'file_replaced' --replace --cat '^snt_hello-world$'
# . (shell-command "snippets.pl --key '@file@' --val 'file_replaced' --replace --cat '^snt_hello-world$'" nil nil)

# :ide: CMD: DEBUG     "snippets.pl --debug=5 -r -p --key '@file@' --val 'file_replaced' --cat '^snt_hello-world$'
# . (shell-command "snippets.pl --debug=5 -r -p --key '@file@' --val 'file_replaced' --cat '^snt_hello-world$'" nil nil)

# :ide: CMD: RPL+PRC   "snippets.pl -r -p --key '@file@' --val 'file_replaced' --cat '^snt_hello-world$'
# . (shell-command "snippets.pl -r -p --key '@file@' --val 'file_replaced' --cat '^snt_hello-world$'" nil nil)

# :ide: CMD: RPL+PRC   "snippets.pl --append 'snt_hello-world' 'ein bisschen appended ...'
# . (shell-command "snippets.pl --append 'snt_hello-world' 'ein bisschen appended ...'" nil nil)

# :ide: COMPILE: --list
# . (let ((args "--list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --debug --as-includes --list
# . (let ((args "--debug --as-includes --list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --debug --list
# . (let ((args "--debug --list")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --debug --replace --process --mode 'emacs-lisp' --cat - TEMP-SNIPPET
# . (let ((args (concat "--debug --replace --process --mode 'emacs-lisp' --cat -")) (txt (snip-shell-single-quote "# |\:snp\:| include ^gen_hd-configuration$\n# |\:snp\:| include ^gen_hd-functions$\n# |\:snp\:| include ^gen_hd-main$\n# |\:snp\:| include ^gen_hd-setup$\n" ))) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args " " txt)))

# :ide: COMPILE: echo TEMP-SNIPPET | --debug --replace --process --mode 'emacs-lisp' --cat -
# . (let ((args (concat "--debug --replace --process --mode 'emacs-lisp' --cat -")) (txt (snip-shell-single-quote "# |\:snp\:| include ^gen_hd-configuration$\n# |\:snp\:| include ^gen_hd-functions$\n# |\:snp\:| include ^gen_hd-main$\n# |\:snp\:| include ^gen_hd-setup$\n" ))) (save-buffer) (compile (concat "echo " txt " | perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: CLN: Clean file (remove excess blank lines and whitespace)
# . (let () (save-excursion (goto-char (point-min)) (set-buffer-modified-p t) (replace-regexp "\n\n\n+" "\n\n" nil) (c-beautify-buffer) (save-buffer)))

# :ide: COMPIlE: "echo 'hello @where@' | snr --debug=7 --key 'hello' --value 'not-so' --key '@where@' --value 'what?' -"
# . (compile "echo 'hello @where@' | snr --debug=7 --key 'hello' --value 'not-so' --key '@where@' --value 'what?' -")

# :ide: COMPIlE: snr --debug=7 el_new
# . (compile "snr --debug=7 el_new")

# :ide: COMPIlE: snc --debug=7 el_new
# . (compile "snc --debug=7 -m el el_new")

# :ide: COMPILE: --debug=7 --mode html --store - http://www.simul.de
# . (let ((args "--debug=7 --mode html --store - http://www.simul.de")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPIlE: snr --debug=7 snip_setup
# . (compile "snr --debug=7 -m gen --accept-cat '^(snip)$' snip_setup")

# :ide: COMPIlE: snr --debug=7 snip_check.define
# . (compile "snr --debug=7 -m gen --accept-cat '^(snip)$' snip_check.define")

# :ide: COMPIlE: snc --debug=7 --no-skip snip_check.define
# . (compile "snc --debug=7 --no-skip -m gen --accept-cat '^(snip)$' snip_check.define")

# :ide: COMPIlE: snc --debug=7 snip_check.define
# . (compile "snc --debug=7 -m snip snip_check.define")

# :ide: COMPIlE: snr --debug=7 whereis_new
# . (compile "snr --debug=7 -m whereis whereis_new")

# :ide: COMPIlE: snr --debug=7 --mark=3 whereis_new
# . (compile "snr --debug=7 --mark=3 -m whereis whereis_new")

# :ide: COMPIlE: snr --mark=3 whereis_new
# . (compile "snr --mark=3 -m whereis whereis_new")

# :ide: COMPIlE: sns --mode snip check.store ' '
# . (compile "rm -f /home/ws/snippets/snip_check.store; sns --debug=7 --mode snip check.store ' '; cat /home/ws/snippets/snip_check.store")

# :ide: +-#+
# . Other Checks ()

# :ide: QUO: $snpu_ind_
# . (insert "$snpu_ind_" )

# :ide: +-#+
# . Quotes ()

# :ide: SNIP: myself
# . (snip-cat-mode (concat "" (buffer-file-name)) nil)

# :ide: RST: myself => HTML, xdg-open
# . (let* ((b (buffer-file-name)) (o (concat b ".html"))) (compile (concat "perl " b " --rst-help | rst2html.py --traceback --cloak-email-addresses >" o " && xdg-open " o "; sleep 2; rm -f " o)))

# :ide: RST: myself => HTML
# . (let ((args "--rst-help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args " | rst2html.py --traceback --cloak-email-addresses")))

# :ide: COMPILE: --rst-min-help
# . (let ((args "--rst-min-help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --rst-help
# . (let ((args "--rst-help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --help
# . (let ((args "--help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: COMPILE: --debug=7 --help
# . (let ((args " --debug=7 --help")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: +-#+
# . HELP ()

# :ide: COMPIlE: snr --debug=7 snip_check.verbatim
# . (compile "snr --debug=7 snip_check.verbatim")

# :ide: QUO: ->{'|:fillme:|'}
# . (insert "->{'|\:fillme\:|'}" )

# :ide: QUO: $chunk->{'|:fillme:|'}
# . (insert "$chunk->{'|\:fillme\:|'}" )

# :ide: COMPIlE: snr snip_check.verbatim
# . (let ((args " --process --replace --cat snip_check.verbatim")) (save-buffer) (compile (concat "perl -I./lib -I../lib -I.. -I../.. -w " (buffer-file-name) " " args)))

# :ide: +-#+
# . Verbatim ()

#
# Local Variables:
# mode: perl
# truncate-lines: t
# End:
