#!/usr/bin/env perl
# -*- cperl -*-
#
# $Id: tred 4559 2011-02-25 12:41:04Z zabokrtsky $
#
##############################################################################
#
# This is "TrEd" - a viewer and editor of tree graphs, such as
# dependency trees. TrEd uses PerlTk library as a GUI toolkit.
#
##############################################################################

use strict;
use 5.008;

BEGIN {
############################################################
# start of BEGIN section
############################################################

if ($^V lt v5.8.3) {
  print STDERR '-' x 50,"\n";
  print STDERR "WARNING: Your version of perl is older than v5.8.3\n";
  print STDERR "THINGS MAY NOT WORK AS EXPECTED OR NOT AT ALL!\n";
  print STDERR '-' x 50,"\n\n";
}

use constant ABOUT =>
  "Copyright (c) 2000-2010 by Petr Pajas\n".
  "This software is distributed under GPL - The General Public Licence\n".
  "Full text of the GPL can be found at http://www.gnu.org/copyleft/gpl.html";

use vars qw($svn_version $version $opt_u $opt_h $opt_c $opt_y
	    $opt_t $opt_W $opt_G $opt_R $opt_X $opt_q $opt_B $opt_p
	    $opt_n $opt_D $opt_v $opt_H $opt_I $opt_Z $opt_e
            $libDir $docDir $list_options $opt_auto_save
	    $macroFile @filelists %filelist_from_extension
	    @openfiles $treeViewOpts $opt_m
            @backends @ISA @EXPORT @open_types @save_types $opt_l $opt_s
            $opt_S
            $insideEval %pckey_shift_translates @recentFiles $tredDebug
            $valueLine $appName $ioBackends %menuBindings %keyBindings
            $NewFileNo $stderr $stdout
	    $userlogin
	    %save_types %backend_map $debug @normal_win_opts @focused_win_opts
	    $locale_charset
	    $no_secondary
	    %HELP %vertical_key_arrow_map 
	    $manpage $listoptions $no_backups $no_locks $noCheckLocks %optmap $carp
	    $tred_d $VERSION
	    $enable_extensions $disable_extensions
            $command $configFile
           );

use Exporter;
@ISA   = qw(Exporter);
@EXPORT= qw($insideEval
            $libDir $stderr $stdout
            @openfiles @filelists &min &max);

use Getopt::Long;
use Pod::Usage;

my $optparser=new Getopt::Long::Parser(config => ["bundling"]);
%optmap =  (
  'quiet|q' => \$opt_q,
  'macro-file|m=s' => \$opt_m,
  'config-file|c=s' => \$opt_c,
  'filelist|l=s' => \$opt_l,
  'context|t=s' => \$opt_t,
  'file-encoding|n=s' => \$opt_n,
  'split-window|p=i' => \$opt_p,
  'version|v' => \$opt_v,
  'help|h' => \$opt_h,
  'usage|u' => \$opt_u,
  'window-embed|W=s' => \$opt_W,
  'no-geometry|G' => \$opt_G,
  'include-macro-file|I=s' => \$opt_I,
  'show-hidden-nodes|H' => \$opt_H,
  'debugging|D' => \$opt_D,
  'no-secondary-files|Y' => \$no_secondary,
  'extra-backends|B=s' => \$opt_B,
  'tectogrammatical-trees|R' => \$opt_R,
  'csts-tree-attributes|X=s' => \$opt_X,
  'stylesheet|s=s' => \$opt_s ,
  'stylesheet-file|S=s' => \$opt_S,
  'resource-dir|Z=s' => \$opt_Z,
  'define-symbol|y=s@' => \$opt_y,
  'option|O=s@' => \$TrEd::Config::override_options,
  'execute|e=s' => \$opt_e,
  'man' => \$manpage,
  "list-options" => \$list_options,
  "no-backups" => \$no_backups,
  "no-locks" => \$no_locks,
  "autosave=i" => \$opt_auto_save,
  "carp" => \$carp,
  "enable-extensions|j=s" => \$enable_extensions,
  "disable-extensions|J=s" => \$disable_extensions,
  "command|C" => \$command,
);
$optparser->getoptions(%optmap) or $opt_u=1;

# Help and usage
if ($opt_u) {
  pod2usage({
    -msg => 'TrEd - a graphical visualizer and editor of tree graphs',
  });
#  exit 0;
}
if ($opt_h) {
  pod2usage(-exitstatus => 0, -verbose => 1);
}
if ($manpage) {
  pod2usage(-exitstatus => 0, -verbose => 2);
}
if ($list_options) {
  foreach my $o (keys %optmap) {
    $o=~s/=.$//;
    foreach my $oo (split /\|/,$o) {
      print sort ((length($oo)>1) ? "--$oo\n" : "-$oo\n");
    }
  }
  exit;
}

# Get user's login name
($userlogin) = (getlogin() || ($^O ne 'MSWin32') && getpwuid($<) || 'unknown');
($userlogin =~ /\S/) || warn "Couldn\'t deterbmine user\'s login name\n";
use Carp;

use IO;
use Cwd;
use File::Spec;
use File::Glob qw(:glob);
use URI::file;
use URI::Escape;
use Fcntl;
use Scalar::Util qw(blessed);
use UNIVERSAL::DOES;

use constant EMPTY => q{};

# Once we got rid of them we call getopt to read all the other options

$SIG{__DIE__} = sub { confess(@_) } if $carp;

# Default values of $libDir used to search for macro-file (tred.mac)
# and default-macro file (tred.def) are specified here. They may be
# overriden by value of LibDir in tred resource file (tredrc or ~/.tredrc - see above).
# It is also used to find TrEd::Config.pm module.

use FindBin;
if (exists $ENV{TREDHOME}) {
  $libDir=$ENV{TREDHOME};
} elsif (-d "$FindBin::RealBin/tredlib") {
  $libDir="$FindBin::RealBin/tredlib";
} elsif (-d "$FindBin::RealBin/../lib/tredlib") {
  $libDir="$FindBin::RealBin/../lib/tredlib";
} elsif (-d "$FindBin::RealBin/../lib/tred") {
  $libDir="$FindBin::RealBin/../lib/tred";
}
print "Libdir: $libDir\n" if ($libDir and $opt_D);

$macroFile=undef;

########## Config file #############
# this must be done before read_config is first used

# We *must* at least find TrEd::Version, TrEd::Utils and TrEd::Config module to learn the correct libDir!!.
unshift @INC,$libDir if -d $libDir;

require TrEd::Utils;
import TrEd::Utils qw(:all);
find_win_home();
setFHEncoding(\*STDERR,':utf8',"STDERR");
setFHEncoding(\*STDOUT,':utf8',"STDOUT");

{
  my $ld=$libDir;
  require TrEd::Version;
  import TrEd::Version;
  $VERSION = TrEd::Version::TRED_VERSION();

  require TrEd::Config;
  import TrEd::Config;
  import TrEd::Config qw(&read_config &apply_config &set_default_config_file_search_list);
  $libDir=$ld;
  $TrEd::Config::quiet = $opt_q;
}

if (defined $opt_c) {
  @TrEd::Config::config_file_search_list=($opt_c); # override any other possible config files
} else {
  set_default_config_file_search_list();
}

my $initial_config;
sub applyInitialConfig { setConfig($initial_config); undef $initial_config }
$TrEd::Config::set_user_config=sub { $initial_config=shift };	# tred specific configuration
$configFile=read_config(); # this may setup a new $libDir

unless (-d $libDir) {
  print <<'EOL';
 TrEd could not find a tredlib directory. You may need to point
 to its location by the TREDHOME variable or add a correct LibDir
 field to your ~/.tredrc.

EOL
    die "Error: Couldn\'t find lib-directory.";
}

unshift @INC,$libDir unless (grep($_ eq $libDir, @INC));
{
  my $libs = File::Spec->catfile($libDir,'libs');
  if (-d $libs) {
    unshift @INC, glob(File::Spec->catfile($libs,'*',''));
  }
}

use XML::LibXML; # this is for Darwin (we want to load our libxml2
                 # before some dependency of Tk loads the system one)
use Tk;
use Tk::Config ();
# process the standard arguments for X resources
Tk::CmdLine::SetArguments();

require Treex::PML;
import Treex::PML;
import Treex::PML qw(&Index $FSError);
import Treex::PML::Schema qw(:constants);
require TrEd::UserAgent;

# require Fslib; # compatibility

sub uniq { my %a; grep { !($a{$_}++) } @_ }

# import min and max functions
require TrEd::MinMax;
import TrEd::MinMax;
#sub first (&@); # prototype it for compile-time
import TrEd::MinMax qw(first);


############################################################
# end of BEGIN section
############################################################
}

if ($opt_v) {
  print <<"EOF";
TrEd $VERSION
Perl: $]
Platform: $^O
Tk: $Tk::VERSION
Treex::PML: $Treex::PML::VERSION
Treex::PML-API: $Treex::PML::API_VERSION
EOF
  exit;
}

applyInitialConfig();

{
  # ensure ~/.tred.d exists
  $tred_d = File::Spec->catdir($ENV{HOME},'.tred.d');
  if (! -d $tred_d) {
    mkdir $tred_d || warn "Could not create tred configuration directory: $tred_d: $!\n";
  }
}

my $pid_file = File::Spec->catfile($tred_d,'tred.pid');

if ($command) {
  if (open(my $fh, '<',$pid_file)) {
    my $pid = <$fh>;
    close $fh;
    if ($pid and kill(0,$pid)) {
      my $cmd_file = File::Spec->catfile($tred_d,'cmd_'.$pid);
      if (sysopen(my $fh, $cmd_file, O_TRUNC|O_CREAT|O_WRONLY, 0600)) {
	my ($command,@args) = @ARGV;
	if ($command eq 'open') {
	  @args = map {
	    my ($filename,$suffix)=parseFileSuffix($_);
	    require Treex::PML::IO;
	    Treex::PML::IO::make_abs_URI($filename)->as_string.$suffix
	    } @args;
	}
	print $fh join("\0",$command,@args);
	close $fh;
	kill "USR2", $pid;
      }
      exit(0);
    }
  }
  if ($ARGV[0] eq 'open') {
    shift;
  } else {
    exit(1);
  }
}
if (open(my $fh, '>',$pid_file)) {
  print $fh $$;
  close $fh;
}

$TrEd::Convert::inputenc=$opt_n if $opt_n;
$TrEd::Config::treeViewOpts->{showHidden} = 1 if $opt_H;
$iconPath = "$libDir/icons/crystal" unless (defined $iconPath);
$macroFile="$libDir/tred.mac" unless (defined $macroFile);
if (defined $opt_m) {
  $macroFile=$opt_m;
}

$Treex::PML::Instance::Reader::STRICT=0;

initStylesheetPaths([split($Treex::PML::resourcePathSplit,$opt_S,-1)]);

$Treex::PML::resourcePath=
  join($Treex::PML::resourcePathSplit,
       map { length($_) ? $_ : $Treex::PML::resourcePath }
       split($Treex::PML::resourcePathSplit, $opt_Z,-1))
  if $opt_Z;

$tredDebug=1 if $opt_D;

$TrEd::TreeView::Debug=1 if $opt_D;
$Treex::PML::Debug=1 if $opt_D;
$Treex::PML::IO::Debug=1 if $opt_D;

# find documentation dir
$docDir = first { -d $_ }
  ("$FindBin::RealBin/documentation",
   "$FindBin::RealBin/../doc/tred",
   "$libDir/../doc/tred",
   "$libDir/../documentation",
  );
if ($docDir ne EMPTY) {
  $docDir = 'file://'.$docDir;
} else {
  $docDir = 'http://ufal.mff.cuni.cz/~pajas/tred';
}

use constant {
  UNDO_ACTIVE_NODE => 1,
  UNDO_ACTIVE_ROOT => 2,
  UNDO_DATA_AND_TREE_ORDER => 3,
  UNDO_TREE_ORDER => 4,
  UNDO_DISPLAYED_TREES => 5,
  UNDO_CURRENT_TREE_AND_TREE_ORDER => 6,
  UNDO_ACTIVE_ROOT_AND_TREE_ORDER => 7,
  UNDO_DATA => 8,
  UNDO_CURRENT_TREE => 9,
};


# make Alt_L and Alt_R work correctly on Darwin
if ($^O eq 'darwin') {
  my $xmodmap = File::Spec->catfile($libDir,'xmodmap.darwin');
  warn "Using xmodmap: $xmodmap\n" unless $opt_q;
  system('xmodmap', $xmodmap) if -f $xmodmap;
}

require Tk::widgets;
import Tk::widgets
  qw(Frame Pane LabFrame Listbox HList Menu
     ItemStyle DialogBox Tiler BrowseEntry Panedwindow Dialog DialogBox
     Scale Adjuster Entry Text);
require Tk::Font;

# import encode and decode functions
require TrEd::Convert;
import TrEd::Convert;

# if ($TrEd::Convert::support_unicode) {
#   require Tk::Entry;
#   require Tk::Text;
# #  require Tk::UCSKeyBind;
# }

# import read_macros etc.
require TrEd::Macros;
import TrEd::Macros;

TrEd::Macros::define_symbol('TRED');
if ($opt_y) {
  foreach my $def (@$opt_y) {
    foreach my $sym (split /,/, $def) {
      if ($sym=~/=/) {
	TrEd::Macros::define_symbol(split(/=/,$sym,2));
      } else {
	TrEd::Macros::define_symbol($sym);
      }
    }
  }
}

require TrEd::Extensions;
import TrEd::Extensions qw(:all);

# tree drawing module
require TrEd::TreeView;

# tree view windowing module
require TrEd::Window;

# tree printing module
require TrEd::Print;

# basic tree operations
require TrEd::Basics;
import TrEd::Basics;

$TrEd::Basics::on_tree_change= \&onTreeChange;
$TrEd::Basics::on_node_change= \&onNodeChange;
$TrEd::Basics::on_current_change= \&onCurrentChange;

eval { require TrEd::Help; };

#load back-ends
@backends=(
  'FS',
  ImportBackends(
    split(/,/,$opt_B),
    split(/,/,$ioBackends),
    qw{NTRED
       Storable
       PML
       CSTS
       TrXML
       TEIXML
       PMLTransform
      })
 );

require Filelist;

require Tk::MiscWorkarounds;
require Tk::MyFileSelect;
require Tk::ImgButton;
require Tk::BindButtons;
require Tk::BindMouseWheel;
require Tk::DialogReturn;
require Tk::ErrorReport;
require Tk::Balloon;
require Tk::JComboBox_0_02;
require Tk::TrEdNodeEdit;
require Tk::TextSearchLine;

require TrEd::Menu;

require Data::Snapshot;
import Data::Snapshot;

*which = eval {
  require File::Which;
  \&File::Which::which
} || sub {};
warn $@ if $@;

$stdout=\*STDOUT;
$stderr=\*STDERR;

%backend_map=(
	      fs => 'FS',
	      csts => 'CSTS',
	      pml => 'PML',
	      trxml => 'TrXML',
	      teixml => 'TEIXML',
	      ntred => 'NTRED',
	      storable => 'Storable'
	 );

@open_types=
  (["Supported",  [qw/.fs .pls .pml .t .a .fs.gz .pls.gz .pml.gz .t.gz .a.gz/]],
   ["FS files",           [qw/.fs .FS .Fs .fs.gz .FS.gz/]],
   ["CSTS files",           [qw/.cst .csts .cst.gz .csts.gz/]],
   ["Perl Storable files",  [qw/.pls .pls.gz/]],
   ["PDT-PML files",  [qw/.t .a .t.gz .a.gz .m .m.gz .pml .pml.gz .xml .xml.gz/]],
   ["XML files",           [qw/.xml .xml.gz .pml .pml.gz/]],
   ["TectoMT files",           [qw/.tmt .tmt.gz/]],
   ["All files",        '*']
  );

%save_types=(
	     fs =>
	     [["FS files",           [qw/.fs .FS .Fs/]],
	      ["gzipped FS files",   [qw/.fs.gz .FS.gz .FS.GZ/]],
	      ["All files",        ['*']]
	     ],
	     pml =>
	     [["PML files",           [qw/.t .a .pml .xml/]],
	      ["gzipped PML files",   [qw/.t.gz .a.gz .pml.gz .xml.gz/]],
	      ["All files",        ['*']]
	     ],
	     csts =>
	     [["CSTS files",           [qw/.cst .csts/]],
	      ["gzipped CSTS files",   [qw/.cst.gz .csts.gz/]],
	      ["All files",        ['*']]
	     ],
	     trxml =>
	     [["TrXML files",          [qw/.trx .trxml .xml/]],
	      ["gzipped TrXML files",   [qw/.trx.gz .trxml.gz .xml.gz/]],
	      ["All files",        ['*']]
	     ],
	     teixml =>
	     [["TEIXML files",          [qw/.tei .xml/]],
	      ["gzipped TEIXML files",   [qw/.tei.gz .xml.gz/]],
	      ["All files",        ['*']]
	     ],
	     storable =>
	     [["Perl Storable files",          [qw/.pls .pls.gz/]],
	      ["All files",        ['*']]
	     ],
	     all => [["All files", ['*']],
		     ["Recognized", [qw/.fs .csts .pls .t .a .pls.gz .fs.gz .t.gz .a.gz .csts.gz .pml .pml.gz .xml .xml.gz .tmt .tmt.gz/]],
		    ]
	    );

# rotation of keyboard bindings for verticalTree mode
my %vertical_key_arrow_map = (
  Left => 'Up',
  Right => 'Down',
  Up => 'Left',
  Down => 'Right',
);

our %context_override_binding;
my %default_binding = (
  '<Tab>' => 
    [ sub { 
	currentNext($_[1]->{focusedWindow}); Tk->break; },
      'select next node',
      'top',
     ],
  '<Shift-ISO_Left_Tab>' => 
    [sub { currentPrev($_[1]->{focusedWindow}); Tk->break; },
     'select previous node',
    ],
  '<Shift-Tab>'=>
    [sub { currentPrev($_[1]->{focusedWindow}); Tk->break; },
     'select previous node',
    ],
  '<period>'=> 
    [sub { onIdleNextTree($_[1]->{focusedWindow}); }, 'go to next tree', ],
  '<comma>'=> 
    [sub { onIdlePrevTree($_[1]->{focusedWindow}); }, 'go to previous tree',
    ],
  '<Next>'=> 
    [sub { onIdleNextTree($_[1]->{focusedWindow}); }, 'go to next tree', ],
  '<Prior>'=> 
    [sub { onIdlePrevTree($_[1]->{focusedWindow}); }, 'go to previous tree', ],
  '<greater>'=>
    [sub { my $fw=$_[1]->{focusedWindow};
	   gotoTree($fw,
		    $fw->{FSFile}->lastTreeNo);
	   Tk->break;
	 },
     'go to last tree in file',
    ],
  '<less>'=> 
    [sub { gotoTree($_[1]->{focusedWindow},0);
	   Tk->break;
	 },
     'go to first tree in file',
    ],
  '<KeyPress-Return>'=>
    [sub { editAttrsDialog($_[1]->{focusedWindow},
			   $_[1]->{focusedWindow}->{currentNode});
	   Tk->break;
	 },
     'view/edit attributes',
    ],
  '<KeyPress-Left>'=>
    [sub {
       my $grp = $_[1];
       if (treeIsVertical($grp)) {
	 currentUp($grp);
       } else {
	 treeIsReversed($grp)
	   ? currentRight($grp)
	   : currentLeft($grp);
       }
       Tk->break;
     },
     'select left sibling',
    ],
  '<Shift-Home>'=>
    [sub {gotoFirstDisplayedNode($_[1]); Tk->break}, 'select left-most node',
   ],
  '<Shift-End>'=>
    [sub {gotoLastDisplayedNode($_[1]); Tk->break}, 'select right-most node',
   ],
  '<Shift-Left>'=>
    [sub {
       my $grp = $_[1];
       currentLeftWholeLevel($grp);
       Tk->break;
     },
     'select previous node on the same level',
    ],
  '<KeyPress-Right>'=>
    [sub {
       my $grp = $_[1];
       if (treeIsVertical($grp)) {
	 currentDown($grp);
       } else {
	 treeIsReversed($grp)
	 ? currentLeft($grp)
	 : currentRight($grp);
       }
       Tk->break;
     },
     'select right sibling',
    ],
  '<Shift-Right>'=>
    [sub {
       my $grp = $_[1];
       currentRightWholeLevel($grp);
       Tk->break;
     },
     'select next node on the same level',
    ],
  '<KeyPress-Up>'=>
    [sub {
       my $grp = $_[1];
       if (treeIsVertical($grp)) {
	 currentLeft($grp);
       } else {
	 currentUp($grp);
       }
       Tk->break;
     },
     'select parent node',
    ],
  '<Shift-Up>'=>
    [sub {
       my $grp = $_[1];
       treeIsReversed($grp)
	 ? currentRightLin($grp)
	 : currentLeftLin($grp);
       Tk->break;
     },
     'select previous node in linear order',
    ],
  '<KeyPress-Down>'=>
    [sub {
       my $grp = $_[1];
       if (treeIsVertical($grp)) {
	 currentRight($grp);
       } else {
	 currentDown($grp);
       }
       Tk->break;
     },
     'select first child-node',
    ],
  '<Shift-Down>'=>
    [sub {
       my $grp = $_[1];
       treeIsReversed($grp)
	 ? currentLeftLin($grp)
	 : currentRightLin($grp);
       Tk->break;
     },
     'select next node in linear order',
    ],
  '<Control-Tab>'=>
    [sub {
       my $grp = $_[1];
       focusNextWindow($grp);
       Tk->break;
     },
     'focus next view',
    ],
  '<Control-Shift-Tab>'=>
    [sub {
       my $grp = $_[1];
       focusPrevWindow($grp);
       Tk->break;
     },
     'focus previous view',
    ],
  '<Control-Shift-ISO_Left_Tab>'=>
    [sub {
       my $grp = $_[1];
       focusPrevWindow($grp);
       Tk->break;
     },
     'focus previous view',
    ],
 );


ApplyGlobalConfig();

# it seems, that under Windoze setting LC_NUMERIC back to us does not
# work, so I recommend not to use czech locales there, unless you
# really want the decimal points to be replaced by commas in
# postscript:-)
use locale;
use POSIX qw(locale_h);

eval {
  ($TrEd::Config::useLocales) && do {
    $ENV{LC_ALL}=undef;
    setlocale(LC_ALL,undef);

    if ($TrEd::Convert::support_unicode) {
      my $lc_collate=setlocale(LC_COLLATE);
      if ($lc_collate !~ /\.utf-?8/i) {
	setlocale(LC_COLLATE,$lc_collate.".UTF-8");
      }
      my $lc_ctype=setlocale(LC_CTYPE);
      $lc_ctype=~s/\.utf-?8//i; # Tk doesn't support this
      setlocale(LC_CTYPE,$lc_ctype);
    }
    setlocale(LC_NUMERIC,"C");
  };

  ($TrEd::Config::useCzechLocales or
     setlocale('LANG') =~ /^cs_CZ|^czech/) && do {
       $ENV{LC_ALL}=undef;
       setlocale(LC_ALL,undef);

       if ($TrEd::Convert::support_unicode) {
	 setlocale(LC_COLLATE,"cs_CZ.UTF-8");
	 setlocale('LANG',"cs_CZ.UTF-8");
	 setlocale('LC_CTYPE',"cs_CZ");
       } else {
	 setlocale(LC_COLLATE,"cs_CZ");
	 setlocale('LANG',"cs_CZ");
       }
       setlocale(LC_NUMERIC,"C");
     };

  setlocale(LC_MESSAGES,"C");
};
warn $@ if $@;

eval {
  require I18N::Langinfo;
  $locale_charset = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
};

print STDERR "Creating filelists...\n" if $tredDebug;

{
  my $default= new Filelist('Default');
  $default->add(0,map {
    my ($filename,$suffix)=parseFileSuffix($_);
    Treex::PML::IO::make_abs_URI($filename)->as_string.$suffix
    } @ARGV) if @ARGV;
  addNewFilelist(undef,$default);
}

createCmdLineFilelists();
createBookmarksFilelist();
loadStdFilelists();

$insideEval=0;

my %searchTemplate;

%pckey_shift_translates= (exclam=> 1, at=> 2, numbersign=> 3,
			   dollar=> 4, percent=> 5, asciicircum=> 6,
			   ampersand=> 7, asterisk=> 8, parenleft=> 9,
			   parenright=> 0, plus=> 'equal',
			   underscore=> 'minus',
			   less=> 'comma', greater=> 'period', 
			   question=> 'slash',
			   colon=> 'semicolon', quotedbl=> 'apostroph',
			   braceleft=> 'bracketleft', 
			   braceright=> 'bracketright',
			   bar=> 'backslash', asciitilde=> 'grave'
			  );

$opt_R && Csts2fs::setupTR();
if ($opt_X ne EMPTY) {
  Csts2fs::setupSpec(split ',',$opt_X,-1);
  Fs2csts::setupSpec(split ',',$opt_X,-1);
}

print STDERR "Reading macros from $macroFile...\n" unless $opt_q;

startMain(); # start the whole thing

print STDERR "TrEd ended.\n" unless $opt_q;

exit_tred();

############################################################
#
# Implementation and auxiliary functions
#
############################################################

sub createCmdLineFilelists {
  # create Default filelists
  return unless ($opt_l);
  my @fl_files;
  my $fh;
  foreach my $l (split /\s*,\s*/,$opt_l) {
    print STDERR "Reading -l filelist $l...\n" if $tredDebug;
    if ($l eq '-') {
      $fh=\*STDIN;
    } else {
      open($fh,'<',$l) or do {
	print STDERR "Warning: Cannot open filelist $l: ".conv_from_locale($!)."\n";
	next;
      };
    }
    my @f=<$fh>;
    shift @f if ($l=~/\.fl$/i and $f[0]!~m{[/.]} and ! -f absolutize($f[0]));
    s/\s+$// for @f;
    if ($l=~/\.fl$/i) {
      # make relative filenames absolute relative to the .fl file
      @f=map { _filelistFullFileName($l,$_) } @f;
    } else {
      @f=absolutize(@f);
    }
    push @fl_files,\@f;

    close($fh) unless $fh==\*STDIN; # we don't close STDIN to avoid problems 
    # with open2 due to unresolved bug in perl: 
    # http://rt.perl.org/rt3/Public/Bug/Display.html?id=37033
    # If this turns out to be a problem, using eval('close($fh)') should work as well.
  }
  # define filelists CmdLine-1, CmdLine-2, etc.
  my $fl_no=1;
  foreach my $files (grep {@$_} @fl_files) {
    my $fl = new Filelist('CmdLine-'.$fl_no);
    $fl->add_arrayref(0, $files);
    addNewFilelist(undef,$fl);
    $fl_no++;
  }
  print STDERR "Done...\n" if $tredDebug;
}

sub createBookmarksFilelist {
  # create Bookmarks filelist
  unless (bookmarkFilelist()) {
    print "Bookmarks: ".$ENV{HOME}.'/.tred_bookmarks'."\n" if $tredDebug;
    my $bookmarks= new Filelist('Bookmarks',$ENV{HOME}.'/.tred_bookmarks');
    addNewFilelist(undef,$bookmarks);
  }
}

sub gotoFirstDisplayedNode {
  my $win = cast_to_win( $_[0] );
  my $tv = $win->treeView;
  my $node = first { $tv->node_is_displayed($_) } @{$win->{Nodes}};
  if ($node) {
    setCurrent($win,$node);
    centerTo($win,$node);
  }
}
sub gotoLastDisplayedNode {
  my $win = cast_to_win( $_[0] );
  my $tv = $win->treeView;
  my $node = first { $tv->node_is_displayed($_) } reverse @{$win->{Nodes}};
  if ($node) {
    setCurrent($win,$node);
    centerTo($win,$node);
  }
}

sub resolve_default_binding {
  my ($grp,$key) =@_;
  my $context = $grp->{focusedWindow}->{macroContext};
  my $key2 = $key;
  $key2=~s/^<KeyPress-/</;
  my $def = ($context_override_binding{$context} &&
	       ($context_override_binding{$context}{$key} || $context_override_binding{$context}{$key2}))
    || $default_binding{$key} || $default_binding{$key2};
  return $def;
}

sub default_binding {
  my ($mw, $key, $grp, @args)=@_;
  my $def = resolve_default_binding($grp,$key);
  if (ref($def->[0]) eq 'CODE') {
    $def->[0]->($mw,$grp,$key,@args);
  } elsif (ref($def->[0]) eq 'Tk::Callback') {
    $def->[0]->Call($mw,$grp,$key,@args);
  }
}

sub change_default_binding {
  my ($grp,$context,$key,$spec)=@_;
  my $def;
  if ($context and $context eq '*') {
    $def = $default_binding{"<$key>"} || $default_binding{"<KeyPress-$key>"};
    return unless $def;
  } else {
    $def = $context_override_binding{$context}{"<KeyPress-$key>"} ||
      ($context_override_binding{$context}{"<$key>"}||=[]);
  }
  my $prev = [@$def[0,1]];
  if (ref($spec) eq 'ARRAY') {
    if (ref($spec->[0]) eq 'ARRAY') {
      $def->[0]=Tk::Callback->new($spec->[0]);
    } else {
      $def->[0]=$spec->[0];
    }
    $def->[1]=$spec->[1];
  }
  return $prev;
}

sub get_default_binding {
  my ($grp,$context,$key)=@_;
  my $def = ($context and $context eq '*') ? ($default_binding{"<KeyPress-$key>"}  || $default_binding{"<$key>"}) :
    ($context_override_binding{$context} && ($context_override_binding{$context}{"<KeyPress-$key>"} ||
					     $context_override_binding{$context}{"<$key>"}));
  return $def ? [@$def[0,1]] : [];
}

sub exit_tred {
  if (open(my $fh, '<',$pid_file)) {
    my $pid = <$fh>;
    if ($pid==$$) {
      unlink $pid_file;
    }
  }
  if (@_) {
    POSIX::_exit(@_);
  } else {
    exit();
  }
}

sub conv_from_locale {
  my ($str)=@_;
  if ($locale_charset and $TrEd::Convert::support_unicode) {
    require Encode;
    return Encode::decode($locale_charset,$str);
  } else {
    return $str;
  }
}

sub icon {
  my ($grp, $name)=@_;
  unless (exists $grp->{icon}{$name}) {
    my @extensions=qw(gif xpm);
    eval { require Tk::PNG };
    if (not($@)) {
      unshift @extensions,'png';
    } else {
      warn "PNG icons not supported by running Tk\n" if $tredDebug;
    }
    # prepend $libDir to relative paths
    my $default=0;
    my $split = ($^O eq "MSWin32") ? ',' : ':';
    my @paths = (map {
      my $p =
      m{^\s*\Q${TrEd::Convert::Ds}\E} ? $_ : $libDir."/icons/".$_;
      $default = 1 if $p eq $libDir."/icons/crystal";
      $p;
    } split(/$split/o,$iconPath));
    # add default theme, unless already in the list
    push @paths, $libDir."/icons/crystal" unless $default;
    DIR: for my $dir (@paths) {
      for my $ext (@extensions) {
	my $file = "$dir/$name.$ext";
	if (-f $file) {
	  if ($ext eq 'xpm') {
	    #print "Loading pixmap icon $file\n" if $tredDebug;
	    $grp->{icon}{$name} = 
	      $grp->{top}->Pixmap(-file => $file);
	  } else {
	    require Tk::PNG if $ext eq 'png';
	    #print "Loading photo icon $file\n" if $tredDebug;
	    $grp->{icon}{$name} = 
	      $grp->{top}->Photo(-format => $ext, -file => $file);
	  }
	  last DIR;
	} else {
	  #print "Icon not found $file\n" if $tredDebug;
	}
      }
    }
  }
  print "No icon found for $name\n" if (not $grp->{icon}{$name} and $tredDebug);
  return $grp->{icon}{$name};
}

sub __debug {
  print STDERR @_,"\n" if $tredDebug;
}

sub get_open_filename {
  my $w = shift;
  my %opts=@_;
  my $ret;
  if ($openFilenameCommand) {
    my $c = $openFilenameCommand;
    my $types = ref($opts{-filetypes}) ?
      join " ",map { "*".$_ } map { @{$_->[1]} } @{$opts{-filetypes}} : "*";
    my $title = $opts{-title} || 'Open';
    my $initialdir = $opts{-initialdir} || '.';
    $c=~s/\%t/"$title"/g;
    $c=~s/\%m/"$types"/g;
    $c=~s/\%d/"$initialdir"/g;
    $ret = `$c`;
    s/\s+$// for $ret;
  } else {
    require Encode;
    $ret = $w->getOpenFile(%opts);
    if (Encode::is_utf8($ret)) {
      warn("Tk dialog returned a UTF-8 string as a filename, forcing bytes using iso-8859-1!\n");
      $ret=Encode::encode('iso-8859-1',$ret);
    }
  }
  return $ret;
}

sub get_save_filename {
  my $w = shift;
  my %opts=@_;
  if ($saveFilenameCommand) {
    my $c = $saveFilenameCommand;
    my $types = ref($opts{-filetypes}) ?
      join " ",map { "*".$_ } map { @{$_->[1]} } @{$opts{-filetypes}} : "*";
    my $title = $opts{-title} || 'Open';
    my $initialdir = $opts{-initialdir}.$TrEd::Convert::Ds || EMPTY;
    my $initialfile = $opts{-initialfile} || EMPTY;
    $c=~s/\%t/"$title"/g;
    $c=~s/\%m/"$types"/g;
    $c=~s/\%d/"$initialdir"/g;
    $c=~s/\%f/"$initialfile"/g;
    my $ret = `$c`;
    s/\s+$// for $ret;
    return $ret;
  } else {
    $w->getSaveFile(%opts);
  }
}

sub get_widget_descendants {
  my ($w)=@_;
  if (blessed($w) and $w->isa('Tk::Widget')) {
    return ($w,map { get_widget_descendants($_) } $w->children);
  } else {
    return ();
  }
}

sub get_all_widgets {
  my ($grp)=@_;
  get_widget_descendants($grp->{top});
}

sub get_entry_type {
  my $Entry = "Entry";
  my @Eopts;
  eval {
    require Tk::HistEntry;
    $Entry = "SimpleHistEntry";
    @Eopts = qw(-case 0 -match 1);
  };
  undef $@;
  return ($Entry,@Eopts);
}

sub set_grp_history {
  my ($grp,$e,$h,$list)=@_;
  if ($e->can('history')){
    push @$list,[$e,$h] if (ref($list)); # just maintains a list of histories
    my $hist = $grp->{"hist_$h"} ||= [];
    $e->history($hist);
  }
}

sub get_grp_history {
  my ($grp,$e,$h)=@_;
  if ($e->can('historyAdd')) {
    $grp->{"hist_$h"}=[] unless ref($grp->{"hist_$h"});
    my $v = $e->get;
    $e->historyAdd($v) if $v ne EMPTY;
    @{$grp->{"hist_$h"}} = $e->history();
  }
}

sub get_grp_histories {
  my ($grp,$list)=@_;
  foreach my $E (@$list) {
    get_grp_history($grp,@$E);
  }
}

sub bookmarkFilelist {
  return findFilelist('Bookmarks')
}


sub setConfig {
  my $confs=shift;
  foreach (0..9) {
    $recentFiles[$_]=$confs->{"recentfile$_"};
  }
  @recentFiles=grep {$_} @recentFiles;

  require Filelist;
  my $fl;
  foreach (sort { substr($a,8)<=>substr($b,8) } grep /^filelist[0-9]+/, keys %$confs) {
    print "Reading $_\n"  if $tredDebug;
    $fl=Filelist->new(undef,$confs->{$_});
    next unless $fl;
    eval {
      print STDERR "Reading filelist ".$fl->filename."\n" if $tredDebug;
      $fl->load();
      addNewFilelist(undef,$fl);
    };
    warn $@ if $@;
  }
  $autoSave = $opt_auto_save if defined $opt_auto_save;
  print STDERR "Applying configuration.\n" if $tredDebug;
}

sub ApplyGlobalConfig {
  my ($grp)=@_;

  my $bg = $treeViewOpts->{backgroundColor} || 'white';
  my $bgoff = $treeViewOpts->{backgroundColorNofocus} || $bg; #'#fbfbfb';
  @normal_win_opts = (qw/-relief flat -borderwidth 0/,
		      -background => $bgoff,
		      -highlightbackground => $bgoff,
		      -highlightthickness  => $highlightWindowWidth, # must be the same as below
		     );
  @focused_win_opts = (qw/-relief flat -borderwidth 0/,
		       -highlightthickness  => $highlightWindowWidth,
		       -highlightbackground => $highlightWindowColor,
		       -bg => $bg
		      );
  $lockFiles=0 if $no_locks;
  return unless $grp;

  delete $grp->{icon};
  foreach my $button (grep { blessed($_) and $_->isa('Tk::Button') } get_all_widgets($grp)) {
    my $icon = $button->cget('-image');
    if (defined $icon) {
      my $f = filename($icon->cget('-file'));
      $f=~s/\..*//;
      my $new = icon($grp,$f);
      Tk::catch {
	$button->configure(-image => $new) if $new;
      };
    }
  }

  update_value_line($grp);
  update_status_info($grp->{focusedWindow});
  print STDERR $@ if $@;
  update_treeviews($grp);
  $grp->{top}->afterCancel($grp->{autoSaveCallback});
  $grp->{autoSaveCallback}=$grp->{top}->repeat($autoSave*60000, [\&autoSaveAll,$grp]) if $autoSave>0;
}

sub update_treeviews {
  my ($grp) = @_;
  foreach my $w (@{$grp->{treeWindows}}) {
    if ($w->{treeView}) {
      my $c = $w->{treeView}->canvas;
      if ($grp->{focusedWindow} == $w) {
	$c->configure(@focused_win_opts);
	$c->itemconfigure('stipple',-state=> 'hidden');
      } else {
	$c->configure(@normal_win_opts);
	$c->itemconfigure('stipple',-state=> $stippleInactiveWindows ? 'normal' : 'hidden');
      }
    }
  }
}

sub lastFileNo {
  my ($win)=@_;
  return $win->{currentFilelist} ? $win->{currentFilelist}->file_count()-1 : -1;
}

sub currentFileNo {
  my ($win)=@_;
  return $win->{currentFileNo};
}

sub cast_to_win {
  my ($gw)=@_;
  return (blessed($gw) and $gw->isa('TrEd::Window')) ? $gw :
    (ref($gw) ? $gw->{focusedWindow} : undef);
}

sub cast_to_grp {
  my ($gw)=@_;
  return (blessed($gw) and $gw->isa('TrEd::Window')) ? $gw->{framegroup} : $gw;
}

sub grp_win {
  my ($gw)=@_;
  return (cast_to_grp($gw),cast_to_win($gw));
}


# TrEd::Window ? should openFile in focusedWindow
sub gotoFile {
  my ($grp_or_win,$fn,$no_recent,$no_redraw)=@_;
  my ($grp,$win) = grp_win($grp_or_win);
  return unless $win->{currentFilelist};
  return 0 if doEvalHook($win,"goto_file_hook",$fn) eq 'stop';
  return 0 if ($fn>=$win->{currentFilelist}->file_count() or $fn<0);
  my $last_no = $win->{currentFileNo};
  $win->{currentFileNo} = $fn;
  my ($fs,$status) = openFile($win,filelistFullFileName($win,$fn),
			      -norecent => $no_recent, -noredraw => $no_redraw,
			      -keep_related=>1
			     );
  $win->{currentFileNo} = $last_no unless $status;
  update_filelist_views($grp,$win->{currentFilelist},0);
  return $status;
}

sub update_filelist_views {
  my ($grp_or_win,$fl,$reload)=@_;
  my ($grp,$win) = grp_win($grp_or_win);
  if ($grp->{Filelist} and ($grp->{filelistCurrentFilelist} == $fl)) {
    update_a_filelist_view($grp,$grp->{Filelist},$fl,$win->{currentFileNo},$reload);
  }
  update_sidepanel_filelist_view($grp,$fl,$reload);
}

sub update_sidepanel_filelist_view {
  my ($grp,$fl,$reload)=@_;
  return unless $fl;
  my $win = $grp->{focusedWindow};
  my $view = $grp->{sidePanel} && $grp->{sidePanel}->widget('filelistView');
  return unless ($view and $view->is_shown);
  my $filelistView=$view->data;
  if ($filelistView and ($win->{currentFilelist} == $fl)) {
    update_a_filelist_view($grp,$filelistView,$fl,$win->{currentFileNo},$reload);
  }
}

sub update_a_filelist_view {
  my ($grp,$fv,$fl,$pos,$reload)=@_;
  if ($fv->can('Subwidget') and $fv->Subwidget('scrolled')) {
    $fv = $fv->Subwidget('scrolled');
  }
  if ($reload) {
    $fl->expand();
    feedHListWithFilelist($grp,$fv,$fl);
  }
#  if (defined($fl->current)) {
#    $pos=max2(0,$fl->position);
#  }
  $fv->selectionClear();
  if ($fv->{default_style_imagetext} and
      $fv->{last_focused} and $fv->info('exists',$fv->{last_focused})) {
    $fv->itemConfigure($fv->{last_focused}, 0, -style => $fv->{default_style_imagetext});
    $fv->{last_focused}=undef;
  }
  my $path=filelistEntryPath($fl,$pos);
  if (defined($path) and length($path) and $fv->info('exists',$path)) {
    if ($fv->{focused_style_imagetext}) {
      $fv->itemConfigure($path, 0, -style => $fv->{focused_style_imagetext});
      $fv->{last_focused}=$path;
    }
    $fv->anchorSet($path);
    $fv->see($path);
    $fv->selectionSet($path);
  }
}

sub filelistFullFileName {
  my ($win, $fn)=@_;
  my $filelist = $win->{currentFilelist};
  return unless ref $filelist;
  _filelistFullFileName($filelist,$filelist->file_at($fn));
}
sub _filelistFullFileName {
  my ($filelist,$filename)=@_;
  return unless ref $filelist;
  my $suffix;
  ($filename,$suffix)=parseFileSuffix($filename);
  return Treex::PML::ResolvePath($filelist->filename(),$filename).$suffix;
}

sub nextOrPrevFile {
  my ($grp_or_win,$delta,$no_recent,$real)=@_;
  my ($grp,$win) = grp_win($grp_or_win);
  return 0 if ($delta==0);
  my $op=$grp->{noOpenFileError};
  $grp->{noOpenFileError}=1;
  my $filename;
  my $pos = $win->{currentFileNo}+$delta;
  if ($real and $win->{FSFile}) {
    my $prev_filename= $win->{FSFile}->filename;
    my $f = $filename = filelistFullFileName($win,$pos);
    ($prev_filename) = parseFileSuffix($prev_filename);
    ($f) = parseFileSuffix($f);
    while (Treex::PML::IO::is_same_filename($f, $prev_filename)) {
      $pos+=$delta;
      $f=$filename=filelistFullFileName($win,$pos);
      ($f) = parseFileSuffix($f);
    }
  } else {
    $filename=filelistFullFileName($win,$pos);
  }
  my $result=gotoFile($win,$pos,$no_recent);
  my $quiet=0;
  my $response;
  while (ref($result) and $result->{ok}==0) {
    my $trees = $win->{FSFile} ? $win->{FSFile}->lastTreeNo+1 : 0;
    unless ($quiet) {
      $response=
	$win->toplevel->ErrorReport(
	  -title => "Error: open failed",
	  -message => "File is unreadable, empty, corrupted, or does not exist ($trees trees read)!"."\nPossible problem was:",
	  -body => $grp->{lastOpenError},
	  -buttons => ["Try next","Skip broken files","Remove from filelist","Cancel"]
	 );
      last if ($response eq "Cancel");
      $quiet=1 if ($response eq "Skip broken files");
    }
    if ($response eq 'Remove from filelist') {
      my $f=filelistFullFileName($win,$pos);
      removeFromFilelist($win,undef,undef,$f);
      if ($delta>0) {
	if ($pos>=$win->{currentFilelist}->file_count()) {
	  $pos = $win->{currentFilelist}->file_count()-1;
	} else {
	  $pos += $delta-1;
	}
      } else {
	$pos += $delta;
      }
    } else {
      $pos += $delta;
    }
    $result=gotoFile($win,$pos,$no_recent);
  }
  $grp->{noOpenFileError}=$op;
  return ref($result) and $result->{ok};
}

sub nextRealFile {
  my ($grp_or_win,$no_recent)=@_;
  return nextOrPrevFile($grp_or_win,1,$no_recent,1);
}

sub prevRealFile {
  my ($grp_or_win,$no_recent)=@_;
  return nextOrPrevFile($grp_or_win,-1,$no_recent,1);
}

sub nextFile {
  my ($grp_or_win,$no_recent)=@_;
  return nextOrPrevFile($grp_or_win,1,$no_recent);
}

sub prevFile {
  my ($grp_or_win,$no_recent)=@_;
  return nextOrPrevFile($grp_or_win,-1,$no_recent);
}

sub tieNextFile {
  my ($grp,$win) = grp_win(shift);
  if ($grp->{tieWindows}) {
    foreach my $w (@{$grp->{treeWindows}}) {
      nextFile($w) if ($w->{FSFile});
    }
  } else {
    nextFile($win) if ($win->{FSFile});
  }
}

sub tiePrevFile {
  my ($grp,$win) = grp_win(shift);
  if ($grp->{tieWindows}) {
    foreach my $w (@{$grp->{treeWindows}}) {
      prevFile($w) if ($w->{FSFile});
    }
  } else {
    prevFile($win) if ($win->{FSFile});
  }
}


sub tieGotoFile {
  my ($grp,$win) = grp_win(shift);
  if ($grp->{tieWindows}) {
    foreach my $w (@{$grp->{treeWindows}}) {
      gotoFile($w,@_) if ($w->{FSFile});
    }
  } else {
    gotoFile($win,@_) if ($win->{FSFile});
  }
}

sub setWindowFile {
  my ($win,$fsfile)=@_;
  $win->{FSFile}=$fsfile;
  if ($fsfile) {
    $win->{treeNo}=$fsfile->currentTreeNo||0;
    $win->{currentNode}=$fsfile->currentNode;
  } else {
    $win->{treeNo}=undef;
    $win->{currentNode}=undef;
  }
  if (isFocused($win)) {
    updateSessionStatus($win->{framegroup});
  }
}

sub resumeFile {
  my ($win,$fsfile,$keep)=@_;
  $keep||=$win->{framegroup}->{keepopen};
  return unless ref($win) and ref($fsfile);
  print "Resuming file ".$fsfile->filename."\n"  if $tredDebug;

  closeFile($win,-keep_postponed => $keep);
  __debug("Using last context: ",$fsfile->appData('last-context'));
  switchContext($win,$fsfile->appData('last-context'));
  __debug("Using last stylesheet: ",$fsfile->appData('last-stylesheet'));
  switchStylesheet($win,$fsfile->appData('last-stylesheet'));

  setWindowFile($win,$fsfile);
  saveFileStateUpdate($win);
}

sub fsfileDisplayingWindows {
  my ($grp,$fsfile)=@_;
  return 
    grep {
      $_->{FSFile} eq $fsfile 
    } @{$grp->{treeWindows}};
}

sub isFocused {
  my ($win)=@_;
  return $win eq $win->{framegroup}->{focusedWindow} ? 1 : 0;
}

sub initAppData {
  my ($fsfile)=@_;
  unless (ref($fsfile->appData('undostack'))) {
    $fsfile->changeAppData('undostack',[]);
    $fsfile->changeAppData('undo',-1);
    $fsfile->changeAppData('lockinfo',undef);
  }
  $fsfile->changeAppData('fs-part-of',[]) unless ref($fsfile->appData('fs-part-of'));
  $fsfile->changeAppData('ref',{}) unless ref($fsfile->appData('ref'));
}

sub setFSLockInfo {
  my ($fsfile,$lockinfo)=@_;
  $fsfile->changeAppData('lockinfo',$lockinfo);
}

sub _clear_err {
  undef $!; undef $@;
}

sub _last_err {
  my ($ret) = grep { $_ ne EMPTY } ($_[0], "$@", conv_from_locale($!));
  return $ret;
}

sub setLock {
  my ($f) = @_; # filename
  my $proto = Treex::PML::IO::get_protocol($f);
  $f=Treex::PML::IO::strip_protocol($f) if ($proto eq 'file');
  return undef if ($proto eq 'ntred' or $proto =~ /$noLockProto/);
  my $lock=eval { Treex::PML::IO::open_backend($f.".lock","w") };
  if ($@ or not ref($lock)) {
    warn "Error creating lock-file: "._last_err()."\n";
    return undef;
  };
  chmod 0644, $lock if ($^O ne "MSWin32" and $proto eq 'file');
  my $mtime = [stat($f)]->[9];
  my $lockinfo = "by user ".$userlogin.'@'.$ENV{HOSTNAME}." pid ".$$." at ".localtime()." mtime: $mtime";
  $lock->print($lockinfo)."\n";
  Treex::PML::IO::close_backend($lock);
  return $lockinfo;
}

sub readLock {
  my ($f) = @_; # filename
  my $proto = Treex::PML::IO::get_protocol($f);
  if ($proto eq 'file') {
    $f=Treex::PML::IO::strip_protocol($f);
    return undef unless -f "$f.lock";
  }

  return undef if ($proto eq 'ntred' or $proto =~ /$noLockProto/);
  my $lockinfo;
  eval {
    print STDERR "reading lock $f.lock\n" if $tredDebug;
    my ($file,$remove_file) = Treex::PML::IO::fetch_file($f.".lock");
    open my $lock,"<",$file;
    $lockinfo = $lock->getline();
    $lock->close();
    unlink $file if $remove_file;
    $lockinfo =~ s/[\n\r]+$//;
  };
  print $@ if $@;
  print STDERR "Fetched lock $lockinfo\n" if $lockinfo and $tredDebug;
  return $lockinfo;
}

sub removeLock {
  my ($fsfile,$f,$force) = @_; # filename
  my $proto;
  if (defined $f) {
    my $proto = Treex::PML::IO::get_protocol($f);
    $f=Treex::PML::IO::strip_protocol($f) if ($proto eq 'file');
  } else {
    $f=$fsfile->filename();
    $proto = ref($f) ? $f->scheme : 'file';
  }
  return undef if ($proto eq 'ntred' or $proto =~ /$noLockProto/);

  local $noCheckLocks=0;
  if ($force or !$fsfile or checkLock($fsfile,$f) =~ /^my|^changed/) {
    print STDERR "removing lock $f.lock\n" if $tredDebug;
    Treex::PML::IO::unlink_uri($f.".lock");
  }
}

# check if a file has .lock
# returns: none (no lock), my (locked by us), locked
sub checkLock {
  my ($fsfile,$f) = @_; # filename
  return 'Ignore' if $noCheckLocks;
  $f = $fsfile->filename() if ($fsfile and not defined($f));
  my $current_mtime = [stat($f)]->[9];
#  return 'none' if (not $f=~s{^file://}{} and $f =~ m{^[[:alnum:]]+://});
  my $lockinfo = readLock($f);
  if ($lockinfo ne EMPTY) {
    my ($user, $host, $pid) = $lockinfo =~ /^by user (.*?)@(.*?) pid (\d+)/;
    if ($fsfile and $fsfile->appData('lockinfo')) {
      my $ourlockinfo = $fsfile->appData('lockinfo');
      my ($mtime)= $ourlockinfo =~ / mtime: (\d+)$/;
      if ($ourlockinfo =~ /^locked (.*)/) {
	if ($1 ne $lockinfo) {
	  return "opened by us ignoring the lock $1, but later locked again ".$lockinfo;
	} elsif ($mtime != $current_mtime) {
	  my $l = $1;
	  $ourlockinfo =~ s/^locked //;
	  $ourlockinfo =~ s/ mtime: .*$//;
	  return "opened by us ignoring the lock $l and later changed by the lock owner";
	} else {
	  return "opened by us ignoring the lock $1, who still owns the lock, but has not saved the file since";
	}
      } elsif ($ourlockinfo ne $lockinfo) {
	if ($current_mtime != $mtime) {
	  return "stolen and changed ".$lockinfo." (previously locked $ourlockinfo)";
	} else {
	  return "stolen (but not yet changed) ".$lockinfo." (previously locked $ourlockinfo)";
	}
      } elsif ($mtime != $current_mtime) {
	return "changed by another program"
      } else {
	return 'my'
      }
    } elsif ($pid == $$ and $user eq $userlogin and $host eq $ENV{HOSTNAME}) {
      return 'my';
    } else {
      return 'locked '.$lockinfo;
    }
  } elsif ($fsfile and $fsfile->appData('lockinfo')) {
    my $ourlockinfo = $fsfile->appData('lockinfo');
    my ($mtime)= $ourlockinfo =~ / mtime: (\d+)$/;
    if ($ourlockinfo =~ /^locked (.*)/) {
      if ($current_mtime != $mtime) {
	$ourlockinfo =~ s/^locked //;
	$ourlockinfo =~ s/ mtime: (.*)$//;
	return "opened by us ignoring a lock $1 who released the lock, but the file has changed since";
      } else {
	return "opened by us ignoring a lock $1, who released the lock without making any changes";
      }
    } else {
      if ($current_mtime != $mtime) {
	return "changed by another program and our lock was removed";
      } else {
	return "originally locked by us but the lock was stolen from us by an unknown thief. The file seems unchanged";
      }
    }
  } else {
    return 'none';
  }
}

sub closeFileInWindow {
  my ($grp_or_win)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $keep;
  if (fsfileDisplayingWindows($grp,
			      $win->{FSFile})<2) {
    $keep=askSaveFile($win,1,1);
    return if $keep == -1;
  }
  closeFile($win, -keep_postponed => $keep);
}

sub filePartOfADisplayedFile {
  my ($grp,$fsfile)=@_;
  return unless $fsfile;
  my $part_of = $fsfile->appData('fs-part-of');
  return unless ref($part_of) and @$part_of;
  return 1 if first { 
    fsfileDisplayingWindows($grp,$_)>0
			or
		      filePartOfADisplayedFile($grp,$_)
		    } @$part_of;
  return 0;
}

sub findToplevelFileFor {
  my ($grp,$fsfile)=@_;
  return unless $fsfile;
  my $part_of = $fsfile->appData('fs-part-of');
  if (ref($part_of) and @$part_of) {
    return uniq map findToplevelFileFor($grp,$_), @$part_of;
  } else {
    return $fsfile;
  }
}

sub closeFile {
  my ($win,%opts)=@_;

  my $fsfile;
  if ($opts{-fsfile}) {
    $fsfile = $opts{-fsfile};
  } else {
    $fsfile = $win->{FSFile};
  }
  if ($fsfile) {
    __debug("Closing ",$fsfile->filename,"; keep postponed: $opts{-keep_postponed}\n");
    doEvalHook($win,"file_close_hook",$fsfile,\%opts);
    $fsfile->currentTreeNo($win->{treeNo});
    $fsfile->currentNode($win->{currentNode});
  } else {
    return;
  }
  my $fn=$fsfile->filename;
  if (!$opts{-keep_postponed}) {
    if (filePartOfADisplayedFile($win->{framegroup},$fsfile)) {
      warn "closeFile: Keeping postponed ".$fsfile->filename." - part of a displayed file\n";
      $opts{-keep_postponed}=1;
    } else {
      my @part_of = findToplevelFileFor($win->{framegroup},$fsfile);
      if ($part_of[0]!=$fsfile) {
	return unless askSaveFile($win,0,1,$fsfile)==0;
	for (@part_of) {
	  closeFile($win,%opts,-fsfile=>$_,-keep_postponed=>0)||return
	}
      }
    }
  }
  my @wins;
  my ($last_context, $last_stylesheet)=($win->{macroContext}, $win->{stylesheet});
  if ($opts{-all_windows} and $fsfile) {
    @wins=fsfileDisplayingWindows($win->{framegroup},$fsfile);
  } elsif (!$opts{-fsfile}) {
    @wins=($win);
  }

  foreach my $w (@wins) {
    $w->{Nodes}=undef;
    #  undef $NodeClipboard;
    $w->{root}=undef;
    $w->{stylesheet}=STYLESHEET_FROM_FILE();
    setWindowFile($w,undef);
    delete $w->{currentNode} if (exists $w->{currentNode});
    $w->{treeView}->clear_pinfo();
    set_value_line($w->{framegroup},EMPTY) if (isFocused($w));
    unless ($opts{-no_update}) {
      get_nodes_win($w);
      redraw_win($w);
    }
  }

  unless ($opts{-no_update}) {
    updateTitle($win->{framegroup});
    updatePostponed($win->{framegroup});
  }

  if ($opts{-keep_postponed} and $fsfile) {
    print STDERR "Postponing ".$fsfile->filename()."\n"  if $tredDebug;
    $fsfile->changeAppData('last-context',$last_context);
    $fsfile->changeAppData('last-stylesheet',$last_stylesheet);
  } else {
    if ($fsfile and not fsfileDisplayingWindows($win->{framegroup},$fsfile)) {
      my $f = $fsfile->filename();
      print STDERR "Removing $f from list of open files\n"  if $tredDebug;
      @openfiles=grep { $_ ne $fsfile } @openfiles;
      addToRecent($win->{framegroup},$f) unless $opts{-norecent} or $fsfile->appData('norecent');
      my $autosave = autosave_filename($f);
      unlink $autosave if defined $autosave;
      removeLock($fsfile,$f);

      # remove dependency
      for my $req_fs (getSecondaryFiles($fsfile)) {
	if (ref($req_fs->appData('fs-part-of'))) {
	  @{$req_fs->appData('fs-part-of')} = grep { $_ != $fsfile } @{$req_fs->appData('fs-part-of')};
	}
	unless (fsfileDisplayingWindows($win->{framegroup},$req_fs)) {
	  print STDERR "Attempting to close dependent ".$req_fs->filename."\n" if $tredDebug;
	  my $answer = askSaveFile($win,1,1,$req_fs);
	  return if $answer == -1;
	  if ($answer == 1) {
	    print STDERR "Keeping dependent ".$req_fs->filename."\n" if $tredDebug;
	  } else {
	    closeFile($win,  %opts, -fsfile => $req_fs,-keep_postponed => 0) || return;
	  }
	}
      }
      undef $fsfile;
    }
  }
  return 1;
}

sub plainErrorMessage {
  my ($grp,$msg)=@_;
  my $top;
  if (ref($grp)=~/^Tk::/) {
    $top = $grp->toplevel;
  } elsif (ref($grp)) {
    my $win = cast_to_win($grp);
    $top = $win->toplevel if ref $win;
  }
  if (ref($top)) {
    $top->messageBox(-icon=> 'error',
		     -message=> $msg,
		     -title=> 'Error', -type=> 'ok');
  } else {
    print STDERR "$msg\n";
  }
}

sub _deleteMenu {
  my ($menu,$item)=@_;
  print STDERR "_deleteMenu $item\n" if $tredDebug;
  my $entry = $menu->entrycget($item,'-menu');
  $menu->delete($item);
  $entry->destroy if $entry;
}

# a simple dialog with one big text entry
sub textDialog {
  my ($grp_or_win,$dialog_opts,$label1_opts,$label2_opts,$text_opts,$msg,$bind)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $d= $grp->{top}->DialogBox( %$dialog_opts   );
  $d->Label( %$label1_opts )
    ->pack(-pady => 5,-side => 'top', -fill => 'x')  if defined $label1_opts;
  $d->Label( %$label2_opts )->pack(-pady => 10,-side => 'top', -fill => 'x')
    if defined $label2_opts;
  my $tags = delete $text_opts->{-tags};
  my $t=$d->Scrolled(
    (delete $text_opts->{-readonly} ? 'ROText' : 'Text'),
    qw/-relief sunken -borderwidth 2 -scrollbars oe/,%$text_opts);
  _deleteMenu($t->Subwidget('scrolled')->menu,'File');
  $t->pack(qw/-side top -expand yes -fill both/);
  $t->BindMouseWheelVert();
  if ($bind) {
    my %b = ( dialog => $d, text => $t );
    foreach my $what (keys %b) {
      if (ref($bind->{$what})) {
	foreach (@{$bind->{$what}}) {
	  $b{$what}->bind(@$_);
	}
      }
    }
  }
  $t->insert('0.0',ref($msg) ? @$msg : $msg);
  $t->markUnset('insert');
  $t->markSet('insert','0.0');
  if (ref($tags)) {
    foreach my $tag (keys %$tags) {
      $t->tagConfigure($tag,@{$tags->{$tag}})
    }
  }
  $t->focus;
  $d->Show;
}


sub userQuery {
  my ($win, $message, %opts) = @_;
  my $d = $win->toplevel->Dialog(
				 %opts
				);
  $d->add('Label', -text => $message,
	  -wraplength => 300)->pack();
  $d->BindReturn($d,1);
  if (exists($opts{-buttons}) and 
      grep { $_ eq 'Cancel' } @{$opts{-buttons}}) {
    $d->BindEscape();

  }
  $d->BindButtons;
  return $d->Show;
}


sub addToRecent {
  my ($grp,$f)=@_;
  return if $grp->{noRecent};
  if (defined($f)) {
    ($f)=absolutize($f);
    @recentFiles=grep { $_ ne $f } @recentFiles;
    unshift @recentFiles,$f;
  }
  @recentFiles=@recentFiles[0..min($#recentFiles,9)];

  if ($grp->{RecentFileMenu}) {
    my $menu= $grp->{RecentFileMenu};
    $menu->delete(0,'end');
    $_->destroy for $menu->children;
    my $i=0;
    foreach my $rf (@recentFiles) {
      $grp->{RecentFileMenu}->command(-label => "$i.  $rf",
				      -underline=> 0,
				      -command=> [\&openStandaloneFile,$grp,$rf]);
      $i++;
    }
  }
}

sub getNodeNo {
  my ($win,$node)=@_;
  if ($node) {
    my $root;
    my $i=0;
    $root=$win->{FSFile}->treeList->[$win->{treeNo}];
    while ($root and $root ne $node) {
      $i++;
      $root=$root->following();
    }
    if ($root) {
      return $i;
    }
  }
}

sub bookmarkThis {
  my ($grp)=@_;
  my $f=undef;
  my $win=$grp->{focusedWindow};
  if (ref($win->{FSFile})) {
    $f=$win->{FSFile}->filename()."##".($win->{treeNo}+1);
    my $nodeno=getNodeNo($win,$win->{currentNode});
    if (defined($nodeno)) {
      $f.=".$nodeno";
    }
  }
  return $f;
}

sub addBookmark {
  my ($grp,$to_filelist)=@_;
  my $bl=defined($to_filelist) ? findFilelist($to_filelist) : bookmarkFilelist();
  return unless ref($bl);
  my $f=bookmarkThis($grp);
  if (defined($f)) {
    insertToFilelist($grp,$bl,$bl->count,$f);
    updateBookmarks($grp);
  }
}

sub lastActionBookmark {
  my ($grp,$bmk)=@_;
  my $f=defined($bmk) ? $bmk : bookmarkThis($grp);
  if (defined($f)) {
    print STDERR "Bookmarking last action at: $f\n" if $tredDebug;
    $grp->{lastActionBookmark}=$f;
    # updateBookmarks($grp);
  }
}

sub updateSessionStatus {
  my ($grp)=@_;
  my $win = $grp->{focusedWindow};
  update_context_list($grp);
  $grp->{keepcurrentfile}=($win->{FSFile} && $win->{FSFile}->appData('noautoclose')) ? 1 : 0;
}

#  $group{BookmarksFileMenu}= MenubarItem($menubar,qw/-label Bookmarks -underline 0/);
#  updateBookmarks(\%group);


sub updateBookmarks {
  my ($grp)=@_;
  return if $grp->{noUpdatePostponed};
  if ($grp->{BookmarksFileMenu}) {
    print STDERR "Updating bookmark menu\n"  if $tredDebug;
    my $menu= $grp->{BookmarksFileMenu}->menu;
    $menu->delete(0,'end');
    $_->destroy for $menu->children;
    my $i=0;
    my $bl=bookmarkFilelist();
    return unless ref ($bl);
    foreach my $b (bookmarkFilelist->files()) {
      print STDERR "$b\n" if $tredDebug;
      $grp->{BookmarksFileMenu}->command(-label => "$i.  ".$b,
				      -underline=> 0,
				      -command=> [ \&openStandaloneFile,$grp,$b ]);
      $i++;
    }
    updateTitle($grp); # e.g. after adding/removing a bookmark to/from a filelist
  }
}

sub updatePostponed {
  my ($grp)=@_;
  return if $grp->{noUpdatePostponed};
  if ($grp->{PostponedFileMenu}) {
    print STDERR "Updating session menu\n"  if $tredDebug;
    my $menu = $grp->{PostponedFileMenu};
    $menu->delete(0,'end');
    $_->destroy for $menu->children;
    # $menu->command(-label=> 'Open files',
    # 				       -state=> 'disabled',
    # 				       -background=> '#444444'
    # 				      );
    my $i=0;
    foreach my $of (@openfiles) {
      $menu->command(-label => "$i.  ".$of->filename(),
				      -underline=> 0,
				      -command=> [\&openStandaloneFile,$grp,
						  $of->filename(),-keep => 1]);
      $i++;
    }
    $menu->command(-label=> 'none',
		   -state=> 'disabled'
		  ) unless (@openfiles);
    {
      my $menu = $grp->{FileListMenu};
      if ($menu) {
	$menu->delete(0,'end');
	$_->destroy for $menu->children;
	createFilelistsMenu($grp, $menu, [\&selectFilelist, $grp]);
      }
    }
    {
      my $menu = $grp->{AddBookmarkMenu};
      if ($menu) {
	$menu->delete(0,'end');
	$_->destroy for $menu->children;
	createFilelistsMenu($grp, $menu, [\&addBookmark, $grp], 1);
      }
    }
  }
}


# for each filelist add an entry to a given menu
# using -command => [ @command, $filelist_name ]
# as menu callback
sub createFilelistsMenu {
  my ($grp,$menu,$command,$bookmark_to)=@_;
  my $i='A';
  foreach my $fl (sort {lc($a->name()) cmp lc($b->name())} 
		  grep { !($bookmark_to and (($filelist_from_extension{$_}||0)==1)) }
		  @filelists) {
    $menu->command(-label => "$i.  ".$fl->name(),
		   -underline=> 0,
		   -command=> [@$command,$fl->name()]);
    $i++;
  }
  if ($bookmark_to) {
    $menu->separator();
    $menu->command(-label => ($bookmark_to ? 'New File List...' : 'Create New File List ...'),
		   -command=> [\&_makeNewFilelist,$grp,\&addBookmark]);
  }
}

sub _makeNewFilelist {
  my ($grp,$action)=@_;
  my $grp = shift;
  my $fl = createNewFilelist($grp);
  if (defined $fl) {
    my $sub = shift;
    my $name = $fl->name;
    $action->($grp,$name) if $action;
    saveStdFilelist($fl);
  }
}

sub updateScaleFactor {
  my ($grp)=@_;
  my $factor = $grp->{focusedWindow}->treeView->scale_factor();
  $grp->{canvasScaleLabel}->configure(-text=>'Scale: '.int(100*$factor).'%');
  $grp->{canvasScale}=($grp->{focusedWindow}->treeView->get_scale||0);
}

sub updateTitle {
  my ($grp)=@_;
  return unless ref($grp);
  return if $grp->{noUpdateTitle};
  my $win = $grp->{focusedWindow};
  if (ref($win->{FSFile})) {
    my $filelist_info=EMPTY;
    if (defined($win->{currentFileNo}) and $win->{currentFilelist}) {
      my $current = $win->{currentFileNo}+1;
      my $all = $win->{currentFilelist}->file_count();
      $filelist_info=$win->{currentFilelist}->name()."($current/$all): ";
      $grp->{prevFileButton}->configure(-state => ($current <= 1) ?
					  'disabled' : 'normal');
      $grp->{nextFileButton}->configure(-state => ($current >= $all) ?
					  'disabled' : 'normal');
    } else {
      for my $b (qw(nextFileButton prevFileButton)) {
	$grp->{$b}->configure(-state => 'disabled');
      }
    }
    for my $b (qw(printButton reloadButton findButton
                  findNextButton findPrevButton sentButton)) {
      $grp->{$b}->configure(-state => 'normal');
    }
    $grp->{top}->title("$appName    ".
		       $filelist_info.
		       $win->{FSFile}->filename()
		      );
  } else {
    for my $b (qw(nextFileButton prevFileButton
                  printButton reloadButton findButton
                  findNextButton findPrevButton sentButton)) {
      $grp->{$b}->configure(-state => 'disabled') if $grp->{$b};
    }
    $grp->{top}->title("$appName");
  }
}

sub updateHelpMenu {
  my ($grp,$opts)=@_;
  $opts||={};
  my $hm = $grp->{main_menu}->lookup_menu_item('MENUBAR:HELP:EXTENSION_MANUALS');
  return unless $hm;
  if ($Tk::platform eq 'unix') {
    # this is a very lame work around a probable bug in Tk
    # n'th menu created (where exact n I don't know)
    # will behave strangely: first attempt to post it by clicking on it
    # will post the menu at or near the top left screen cornder
    # rather than on a given x,y; next time, the menu works fine
    #
    # Currently this affects this particular menu,
    # which we now programmatedly post and unpost
    #
    $hm->post(0,0);
    $hm->unpost;
  }
  $hm->delete(0,'end');
  $_->destroy for $hm->children;
  my $preinst_dir = getPreInstalledExtensionsDir();
  my ($extensions,$pre_installed) = @{
    $opts->{preparedExtensions} ||
    prepareExtensions($grp) ||
    [[],[]]
  };
  my %m;
  foreach my $m (
    (map [ $_, getExtensionDocPaths([$_]) ], @$extensions),
    (map [ $_, getExtensionDocPaths([$_],$preinst_dir) ], @$pre_installed)) {
    $m{$m->[0]} = $m->[1] unless exists $m{$m->[0]};
  }
  for my $ext (sort keys %m) {
    my $index = File::Spec->catfile($m{$ext},'index.html');
    if (-f $index) {
      my $url = URI::file->new($index);
      $hm->add('command',
	       -label => $ext,
	       -command => [\&open_url_in_browser,$url]);
    }
  }
}

sub newFileFromCurrent {
  my ($grp,$keep)=@_;
  $keep||=$grp->{keepopen};
  my $win=$grp->{focusedWindow};
  return unless $win->{FSFile};
  $win->toplevel->Busy(-recurse=> 1) unless $insideEval;
  my $cur=$win->{FSFile};
  my $new=$cur->clone(0);

  $new->changeURL('unnamed'.sprintf('%03d',$NewFileNo++));
  $cur=undef;
  my $answer = askSaveFile($win,1,1);
  return 0 if $answer == -1;
  $keep=$keep || $answer;
  closeFile($win,-no_update => 1,-keep_postponed => $keep);
#  $new->new_tree(0);
  setWindowFile($win,$new);
  push @openfiles, $win->{FSFile};
  updatePostponed($grp);

  updateTitle($grp);
  $win->{redrawn}=0; # if redraw is called during the hook, we will know it
  get_nodes_win($win);
  if ($opt_t ne EMPTY and
	$win->{macroContext} ne $opt_t) {
    switchContext($win,$opt_t,1);
  } else {
    doEvalHook($win,"guess_context_hook","file_opened_hook");
  }
  doEvalHook($win,"file_opened_hook");
  redraw_win($win) unless $win->{redrawn};
  centerTo($win,$win->{currentNode});
  $win->toplevel->Unbusy() unless $insideEval;

#  addToRecent($grp,$new->filename);
  return 1;
}


# openStandaloneFile should be called whenever a file is opened via
# a non-filelist operation (that is other than nextFile, or gotoFile)

sub openStandaloneFile {
  my ($grp_or_win,$file) = @_;
  my ($grp,$win)=grp_win($grp_or_win);
  if ($grp->{appenddefault}) {
    my $ret = openFile(@_);
    if ($ret) {
      my $fl=selectFilelistNoUpdate($grp,'Default',1);
      my $pos=insertToFilelist($win,
			       $win->{currentFilelist},
			       $win->{currentFileNo},
			       $file);
      $win->{currentFileNo} = $pos if $pos >= 0;
      update_filelist_views($grp,$win->{currentFilelist},0);
    }
    updateTitle($grp);
    return $ret;
  } else {
    my $ret = openFile(@_);
    undef $win->{currentFilelist};
    $win->{currentFileNo} = -1;
    updateTitle($grp);
    return $ret;
  }
}


sub reloadFile {
  my ($grp_or_win) = @_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $fsfile = $win->{FSFile};
  if (ref($fsfile) and $fsfile->filename()) {
    my $f=$fsfile->filename();
    my @patterns=$fsfile->patterns();
    my $hint=$fsfile->hint();
    ($f)=parseFileSuffix($f);
    if ($fsfile->lastTreeNo >= 0) {
      my $no=$win->{treeNo}+1;
      my $nodeidx=0;
      do {			# $node is undefined after this block
	my $node=$win->{currentNode};
	while ($node) { $nodeidx++; $node=$node->previous() };
      };
      $nodeidx-- if $nodeidx>=0;
      $f = "$f##$no.$nodeidx";
    }
    return if askSaveFile($win,0,1) == -1;
    my $ctxt = $grp->{selectedContext};
    closeFile($win,-all_windows => 1);
    openFile($win, $f, -noredraw => 1, -nohook=>1);
    if ($ctxt ne $grp->{selectedContext}) {
      switchContext($win,$ctxt,1);
    }
    $fsfile = $win->{FSFile};
    if ($fsfile) {
      if ($reloadKeepsPatterns) {
	$fsfile->changePatterns(@patterns);
	$fsfile->changeHint($hint);
      }
      doEvalHook($win,"file_reloaded_hook");
    }
    get_nodes_win($win);
    redraw_win($win);
    centerTo($win,$win->{currentNode});
  }
}

sub _new_status {
  my %status = (
    ok => undef,
    cancel => undef,
    warnings => [],
    error => undef,
    filename => undef,
    backends => undef,
    report => undef,
    @_
  );
  return \%status;
}

sub loadFile {
  my ($grp,$file,$backends)=@_;
  $grp = cast_to_grp($grp);
  my @warnings;
  my $bck = ref($backends) ? $backends : \@backends;
  my $status = _new_status(ok => 0, filename => $file, backends => $bck, warnings => \@warnings);
  _clear_err();
  local $SIG{__WARN__} = sub { my $msg = shift; chomp $msg; print STDERR $msg."\n"; push @warnings,$msg; };
  my $fsfile = Treex::PML::Factory->createDocumentFromFile(
    $file,
    {
      encoding => $TrEd::Convert::inputenc,
      backends => $bck,
      recover => 1,
    });
  my $error = $Treex::PML::FSError;
  $status->{error} = $error==1 ? 'No suitable backend!' : _last_err();
  $status->{report} = "Loading file '$file':\n\n";

  if (ref($fsfile) and $fsfile->lastTreeNo>=0 and $error==0) {
    $status->{ok} = @warnings ? -1 : 1;
  } else {
    if (ref($fsfile) and $error==0) {
      push @warnings, "NO TREES FOUND in this file.";
      $status->{ok} = -1;
    } else {
      $status->{ok} = 0;
      $status->{report} .= "ERRORS:\n\n".$status->{error}."\n";
    }
  }
  if (@warnings) {
    $status->{report} .= join "\n", "WARNINGS:\n",@warnings;
  }

  $grp->{lastOpenError}=$status->{report};

  if (wantarray) {
    return ($fsfile, $status);  
  } else {
    return $fsfile;
  }
}

sub merge_status {
  my ($status1, $status2) = @_;
  if ($status1->{ok}==1) {
    $status1->{ok} = $status2->{ok};
  } elsif ($status2->{ok} != 1) {
    $status1->{ok} = max2($status2->{ok}, $status1->{ok});
  }
  push @{$status1->{warnings}}, @{$status2->{warnings}};
  $status1->{error} .= "\n".$status2->{error} if $status2->{error} ne EMPTY;
  $status1->{report} .= "\n".$status2->{report} if $status2->{report} ne EMPTY;
}

sub openFile {
  my ($grp_or_win,$fname,%opts)= @_;
  my ($grp,$win)=grp_win($grp_or_win);
  unless ($opts{-nohook}) {
    if (doEvalHook($win,"open_file_hook",$fname,{%opts}) eq 'stop') {
      # not sure what status should we return
      return wantarray ? ($win->{FSFile},_new_status(ok => 1)) : $win->{FSFile};
    }
  }

  my $no_err = $grp->{noOpenFileError};
  my $fsfile = $win->{FSFile};

  my ($f,$goto) = parseFileSuffix($fname);
  print "Goto suffix is $goto\n" if defined($goto) and $tredDebug;

  $opts{-keep} ||= $grp->{keepfiles};
  if (!$opts{-keep} and $opts{-keep_related}) {
    if ($tredDebug and $fsfile) {
      print STDERR "got -keep_related flag for open $f:\n";
      print STDERR map { $_->filename."\n" } getSecondaryFiles($fsfile), @{$fsfile->appData('fs-part-of')};
    }
    $opts{-keep}=1 if
      $fsfile and
	first { $_->filename eq $f } (getSecondaryFiles($fsfile), @{$fsfile->appData('fs-part-of')});
    print STDERR "keep: $opts{-keep}\n" if $tredDebug;
  }

  $win->toplevel->Busy(-recurse=> 1) unless $insideEval;

  # File already open in current window? Simple!
  if ($fsfile and Treex::PML::IO::is_same_filename($fsfile->filename(),$f)) {
    unless ($opts{-preload}) {
      updateTitle($grp);
      applyFileSuffix($win,$goto);
      unhideCurrentNode($win);
      get_nodes_win($win, $opts{-noredraw});
      unless ($opts{-nohook}) {
	doEvalHook($win,"guess_context_hook","file_resumed_hook");
	doEvalHook($win,"file_resumed_hook");
      }
      unless ($opts{-noredraw}) {
	redraw_win($win);
	centerTo($win,$win->{currentNode});
      }
      addToRecent($grp,$f) unless ($opts{-norecent} or $fsfile->appData('norecent'));
    }
    $win->toplevel->Unbusy() unless $insideEval;
    return wantarray ? ($fsfile,_new_status(ok => 1)) : $fsfile;
  }

  # the current file would get open again as a secondary file to $f
  if ($fsfile and
      first {
	Treex::PML::IO::is_same_filename($_->filename(),$f) } getPrimaryFilesRecursively($fsfile)) {
    $opts{-keep} = 1;
  }

  # Shell we close current file?
  unless ($opts{-preload} or $opts{-keep}) {
    if (fsfileDisplayingWindows($grp,$fsfile)<2) {
      my $answer = askSaveFile($win,1,1);
      if ($answer == -1) {
	$win->toplevel->Unbusy() unless $insideEval;
	return wantarray ? (undef,_new_status(cancel => 1)) : undef;
      }
      $opts{-keep} = $answer;
    }
  }
  closeFile($win,-no_update =>1 ,
	    -keep_postponed => ($opts{-keep}||($fsfile&&$fsfile->appData('noautoclose'))))
    unless $opts{-preload};

  # Search open files for requested file, resume if available
  unless ($opts{-justheader}) {
    foreach my $of ($fsfile,@openfiles) {
      if (ref($of) and Treex::PML::IO::is_same_filename($of->filename,$f)) {
	print "Opening postponed file\n" if $tredDebug;
	unless ($opts{-preload}) {
	  resumeFile($win,$of,$opts{-keep});
	  updateTitle($grp);
	  applyFileSuffix($win,$goto);
	  unhideCurrentNode($win);
	  get_nodes_win($win, $opts{-noredraw});
	  unless ($opts{-nohook}) {
	    doEvalHook($win,"guess_context_hook","file_resumed_hook");
	    doEvalHook($win,"file_resumed_hook");
	  }
	  unless ($opts{-noredraw}) {
	    redraw_win($win);
	    centerTo($win,$win->{currentNode});
	  }
	  addToRecent($grp,$f) unless ($opts{-norecent} or $fsfile and $fsfile->appData('norecent'));
	}
	$win->toplevel->Unbusy() unless $insideEval;
	return wantarray ? ($of,_new_status(ok=>1)) : $of
      }
    }
  }

  # We're going to open a file: check locks
  my $lockinfo;
  unless ($opts{-justheader}) {
    $lockinfo = lockFile($win,$f,\%opts);
    if ($lockinfo eq 'Cancel') {
      return wantarray ? (undef, _new_status(cancel=>1)) : undef;
    }
  }

  # Check autosave file
  my $recover='No';
  my $autosave=autosave_filename($f);
  if (not $no_err and defined($autosave) and -r $autosave) {
    $recover=
      userQuery($win,
		"File seems to have an auto-saved recovery file from a previous session.\n".
		"Shell I try to use the recovery file?",
		-bitmap=> 'question',
		-title => "Recover file?",
		-buttons => ['Yes', 'No', 'No, delete recovery file']);
  }

  my $backends = doEvalHook($win,'get_backends_hook',@backends);
  # Autosave file requested
  my $status = { ok => 0 };

  if ($recover eq 'Yes') {
    # Open recovery file

    ($fsfile,$status) = loadFile($grp,$autosave,$backends);
    initAppData($fsfile) if ref($fsfile);
    if ($status->{ok}) {
      # Success
      $fsfile->changeFilename($f);
      $fsfile->notSaved(2);
      setFSLockInfo($fsfile, $lockinfo) if $lockFiles;
      if ($status->{ok}<0) {
	errorMessage($win,$status->{report},'warn');
      }
    } else {
      # Recovery failed
      my $trees=$fsfile ? $fsfile->lastTreeNo+1 : 0;
      my $answer =
	$win->toplevel->ErrorReport(
	  -title => "Error: recovery failed",
	  -message => "Recovery file is corrupted ($trees trees read)!"."\nPossible problem was:",
	  -body => $status->{report},
	  -buttons => ['Open the original file', 'Ignore', 'Cancel'],
       );
      if ($answer eq 'Open the original file') {
	closeFile($win,-no_update => 1) unless $opts{-preload};

	($fsfile,$status) = loadFile($grp,$f,$backends);
	initAppData($fsfile) if ref($fsfile);
	setFSLockInfo($fsfile, $lockinfo) if $lockFiles;
      } elsif ($answer eq 'Ignore') {
	redraw_win($win) unless ($opts{-preload} or $opts{-noredraw});
	$win->toplevel->Unbusy() unless $insideEval;
	return wantarray ? (undef, _new_status(cancel=>1)) : undef;
      }	else {
	closeFile($win,-no_update => 1) unless
	  $opts{-preload} or $fsfile->lastTreeNo>=0;
	$no_err=1;
      }
    }
  } else {
    if ($recover eq 'No, delete recovery file') {
      unlink $autosave;
    }
    # Open requeseted file

    ($fsfile,$status) = loadFile($grp,$f,$backends);
    initAppData($fsfile) if ref($fsfile);
    setFSLockInfo($fsfile, $lockinfo) if $lockFiles;
  }

  if ($status->{ok}) {
    $fsfile->changeFileFormat(($f=~/\.gz$/ ? "gz-compressed " : EMPTY).$fsfile->backend);
    unless ($no_secondary) {
      $status = openSecondaryFiles($win,$fsfile,$status)
	or undef $fsfile;
    }
  }
  # don't make this an else for the above if: something might have changed in
  # the above block
  if ($status->{ok}==0) {
    unless ($no_err) {
      my $trees=$fsfile ? $fsfile->lastTreeNo+1 : 0;
      $win->toplevel->ErrorReport(
	-title => "Error: open failed",
	-message => "File '$f' is unreadable, empty, corrupted, or does not exist ($trees trees read)!"."\nPossible problem was:",
	-body => $status->{report},
       );
    }
    closeFile($win,-no_update => 1) unless $opts{-preload};
    removeLock(undef, $f) if $lockinfo and $lockinfo !~ /^locked/;
  } elsif ($status->{ok}<1) {
    errorMessage($win,$status->{report},'warn');
  }
  setWindowFile($win,$fsfile) unless $opts{-preload};
  if ($fsfile) {
    if ($opts{-justheader}) {
      $f=sprintf('%03d',$NewFileNo++)."_new_".filename($f);
      $fsfile->changeFilename($f);
      $fsfile->changeTrees();
#      $fsfile->new_tree(0);
      $fsfile->notSaved(1);
    }
    push @openfiles, $fsfile;
  }
  updatePostponed($grp);
  # add file to filelist
  updateTitle($grp) unless $opts{-preload};

  my $save_current;
  unless ($opts{-preload}) {
    applyFileSuffix($win,$goto);
    $save_current = $win->{currentNode};
    unhideCurrentNode($win);
    get_nodes_win($win, 1); # for the hook below
  }
  my $r = $win->{redrawn}; # if redraw is called during the hook, we will know it
  if ($opts{-preload}) {
    if ($fsfile and !$opts{-nohook}) {
      doEvalHook($win,"guess_context_hook","file_opened_hook");
      doEvalHook($win,"file_opened_hook");
    }
  } else {
    if ($opt_t ne EMPTY and $win->{macroContext} ne $opt_t) {
      switchContext($win,$opt_t,1)
    } else {
      doEvalHook($win,"guess_context_hook","file_opened_hook") if ($fsfile and !$opts{-nohook});
    }
    doEvalHook($win,"file_opened_hook") if ($fsfile and !$opts{-nohook});
    unless ($opts{-noredraw}) {
      unless ($win->{redrawn}>$r) {
	$win->{currentNode} = $save_current if $save_current;
	get_nodes_win($win); # the hook may have changed something
	redraw_win($win);
      }
      centerTo($win,$win->{currentNode});
    }
  }
  $win->toplevel->Unbusy() unless $insideEval;

  addToRecent($grp,$f) unless ($opts{-norecent} or $fsfile && $fsfile->appData('norecent'));
  return wantarray ? ($fsfile,$status) : $fsfile;
}

sub lockFile {
  my ($win,$f,$opts)=@_;
  my $lock = checkLock(undef,$f);
  print STDERR "LOCK: $lock\n" if $tredDebug;
  my $lockinfo;
  if ($lock  =~ /^locked/) {
    my $answer = userQuery($win,
			   "File $f is $lock.",
			   -bitmap=> 'question',
			   -title => "Accessing locked file?",
			   -buttons => ['Open anyway', 'Steal lock', 'Cancel']);
    if ($answer eq 'Cancel') {
      redraw_win($win) unless ($opts and ($opts->{-preload} or $opts->{-noredraw}));
      $win->toplevel->Unbusy() unless $insideEval;
      return 'Cancel';
    } elsif ($answer eq 'Steal lock') {
      $lockinfo=setLock($f)
    } else {
      $lockinfo = $lock;
      print STDERR "LOCKINFO: $lockinfo\n";
    }
  } elsif ($lockFiles) {
    $lockinfo=setLock($f);
  }
  return $lockinfo;
}

sub lockOpenFile {
  my ($win,$fsfile)=@_;
  $fsfile ||= $win->{FSFile};
  if ($lockFiles and !defined($fsfile->appData('lockinfo'))) {
    my $lockinfo = lockFile($win,$fsfile->filename,{-noredraw => 1});
    setFSLockInfo($fsfile, $lockinfo) if $lockinfo ne 'Cancel';
  }
}

sub openSecondaryFiles {
  my ($win, $fsfile, $status)=@_;
  # if backend requested another FS-file, load it
  # and store it in appData('ref') hash table
  #
  # mark this secondary FS-file as part of the original file
  # so that they can be closed together
  $status ||= _new_status(ok=>1);
  return $status if $fsfile->appData('fs-require-loaded');
  $fsfile->changeAppData('fs-require-loaded',1);
  my $requires = $fsfile->metaData('fs-require');
  if ($requires) {
    for my $req (@$requires) {
      next if ref($fsfile->appData('ref')->{$req->[0]});
      my $req_filename = absolutize_path($fsfile->filename,$req->[1]);
      print STDERR "Pre-loading dependent $req_filename ($req->[1]) as appData('ref')->{$req->[0]}\n" if $tredDebug;
      my ($req_fs,$status2) = openFile($win,$req_filename,-preload => 1, -norecent=>1);
      merge_status($status,$status2);
      if (!$status2->{ok}) {
	closeFile($win, -fsfile => $req_fs, -no_update => 1);
	return $status2;
      } else {
	push @{ $req_fs->appData('fs-part-of') }, $fsfile; # is this a good idea?
	__debug("Setting appData('ref')->{$req->[0]} to $req_fs");
	$fsfile->appData('ref')->{$req->[0]}=$req_fs;
      }
    }
  }
  return $status;
}

sub unhideCurrentNode {
  my ($win)=@_;
  if ($win->{currentNode}) {
    unless (isShown($win,$win->{currentNode})) {
      $win->treeView->set_showHidden(1);
    }
  }
}

sub autosave_filename {
  my ($f)=@_;
  my $base=filename($f);
  return undef unless ($f=~s/\Q${base}\E$/#$base#.#tred#/);
  return $f;
}

sub autoSaveAll {
  my ($grp)=@_;
  my $top=$grp->{top};
  my @files=grep { ($_->notSaved == 1) and !$_->appData('noautosave') } @openfiles;
  return unless @files;
  $top->title("Autosaving...");
  $top->update;
  $top->Busy(-recurse=> 1) if (!$insideEval);
  foreach my $fsfile (@files) {
    my $f=autosave_filename($fsfile->filename);
    print STDERR "auto-saving recovery file ".$fsfile->filename." to '$f'\n" if $tredDebug;

    # this is not a kosher implementation but
    # there is no way to call a hook on fsfile
    # not owned by any windows, sigh!
    my ($win) = fsfileDisplayingWindows($grp,$fsfile);
    $win = $grp->{focusedWindow} unless $win;
    return if doEvalHook($win,"file_autosave_hook",$fsfile) eq 'stop';

    my $ok = 0;
    eval {
      $fsfile->changeAppData('refs_save',{});
      my $status = $fsfile->writeFile($f);
      $ok = 1 unless
	doEvalHook($win,"after_autosave_hook",$f,$status) eq 'stop';
      $fsfile->changeAppData('refs_save',undef);
    };
    unless ($ok) {
      $fsfile->changeAppData('refs_save',undef);
      print STDERR "Error auto-saving file to '$f'\n("._last_err()."\n";
      next;
    }
    $fsfile->notSaved(2);
  }
  updateTitle($grp);
  $top->Unbusy() unless $insideEval;
}

sub saveFile {
  my ($win,$f)=@_;
  $win=cast_to_win($win);
  my $fsfile;
  if (UNIVERSAL::DOES::does($f,'Treex::PML::Document')) {
    $fsfile = $f;
    $f=$f->filename;
  } else {
    $fsfile = $win->{FSFile};
  }
  return unless $fsfile;
  unless (defined($f)) {
    $f=$fsfile->filename;
    if ($f =~ /^unnamed\d+$/) {
      my $ret =  saveFileAs($win);
      if ($ret) {
	# now we may add the file to the current filelist?
	$win->{currentFileNo} = max2(0,$win->{currentFileNo});
	my $pos=insertToFilelist($win,
				 $win->{currentFilelist},
				 $win->{currentFileNo},
				 $fsfile->filename);
	$win->{currentFileNo} = $pos if $pos >= 0;
	update_filelist_views($win,$win->{currentFilelist},0);
      }
      return $ret;
    }
  }

  my $lock = checkLock($fsfile,$f);
  if ($lock =~ /^locked|^stolen|^opened/) {
    if (userQuery($win,
		  "File $f was $lock!",
		  -bitmap=> 'question',
		  -title => "Saving locked file?",
		  -buttons => ['Steal lock and save','Cancel']) eq 'Cancel') {
      $win->toplevel->Unbusy() unless $insideEval;
      return -1;
    }
  } elsif ($lock =~ /^originally locked by us/) {
    if (userQuery($win,
		  "File $f has been $lock, so saving it now seems quite safe.",
		  -bitmap=> 'question',
		  -title => "Saving changed file?",
		  -buttons => ['Save','Cancel']) eq 'Cancel') {
      $win->toplevel->Unbusy() unless $insideEval;
      return -1;
    }
  } elsif ($lock =~ /^changed/) {
    if (userQuery($win,
		  "File $f has been $lock! Saving it now would overwrite those changes made by the other program.",
		  -bitmap=> 'question',
		  -title => "Saving changed file?",
		  -buttons => ['Save anyway','Cancel']) eq 'Cancel') {
      $win->toplevel->Unbusy() unless $insideEval;
      return -1;
    }
  }

  $win->toplevel->Busy(-recurse=> 1) unless $insideEval;

  my $refs_to_save={};
  if (!askSaveReferences($win,$fsfile,$refs_to_save,$f) or
      doEvalHook($win,"file_save_hook",$f) eq 'stop') {
    updateTitle($win->{framegroup});
    $win->toplevel->Unbusy() unless $insideEval;
    return;
  }
  eval {
    Treex::PML::IO::rename_uri($f,$f."~") unless $f=~/^ntred:/
  };
  print STDERR $@;
  $fsfile->changeAppData('refs_save',$refs_to_save);
  my $result;
  my $stop;
  my @warnings;
  my $err;
  {
    local $SIG{__WARN__} = sub { my $msg = shift; chomp $msg; push @warnings,$msg; };
    eval { 
      $result = $fsfile->writeFile($f);
    };
    $err = $@;
    # called from within the eval so all errors and warnings
    # are shown as warnings on the output
    $stop = doEvalHook($win,"after_save_hook",$f,$result);
  }
  $fsfile->changeAppData('refs_save',undef);
  if (!$result or $stop eq "stop_fatal") {
    $win->toplevel->Unbusy() unless $insideEval;
    $fsfile->notSaved(1);
    saveFileStateUpdate($win) if $fsfile == $win->{FSFile};
    errorMessage($win,"Error while saving file to '$f'!\nI'll try to recover the original from backup.\n"._last_err($err."\n".(@warnings ? join("\n",'WARNINGS:',@warnings) : ''))."\n"."Check file and directory permissions.\nSee also the console error output.");
    undef $!;
    eval {
      Treex::PML::IO::rename_uri($f."~",$f) unless $f=~/^ntred:/; # if (-f $f);
    };
    if (_last_err()) {
      my $err = "Error while renaming backup file $f~ back to $f.\n";
      errorMessage($win,$err,1);
    }
    return -1;
  } elsif (@warnings) {
    errorMessage($win,"Saving file to '$f':\n\n".
		   join("\n",@warnings),'warn');
  } else {
    Treex::PML::IO::unlink_uri($f."~") if $no_backups;
  }
  setFSLockInfo($fsfile, setLock($f)) if $lockFiles;
  my $autosave=autosave_filename($f);
  unlink $autosave if defined($autosave);
  $win->toplevel->Unbusy() unless $insideEval;
  my $ret = 1;
  if ($stop eq "stop") {
    # SILENT STOP
    # file is considered saved
    $ret = -1;
  } elsif ($stop eq "stop_nonfatal") {
    $fsfile->notSaved(1);
    $ret = -1;
  }
  addToRecent($win->{framegroup},$f);
  saveFileStateUpdate($win) if $fsfile == $win->{FSFile};
  return $ret;
}

sub isShown { # test if node is shown (always 1 if $showHidden)
  my ($win,$node,$show)=@_;
  $show=$win->treeView->get_showHidden() unless defined $show;
  return 0 unless ($node and $win->{FSFile});
  return (!$show and $win->{FSFile}->FS->isHidden($node)) ? 0 : 1;
}

sub HNext { # same as Next but obey $showHidden
  my ($win,$node,$top)= @_;
  $node=$node->following($top);
  while ($node) {
    return $node if (isShown($win,$node));
    $node=$node->following($top);
  }
  return 0;
}

sub HPrev { # same as Next but obey $showHidden
  my ($win,$node,$top)= @_;
  $node=$node->previous($top);
  while ($node) {
    return $node if (isShown($win,$node));
    $node=$node->previous($top);
  }
  return 0;
}

sub DisplayedAncestor {
  my ($win,$node)= @_;
  my $tv = $win->treeView;
  $node = $node->parent;
  while ($node and !$tv->node_is_displayed($node)) {
    $node = $node->parent;
  }
  return $node;
}

sub NextDisplayed { # same as Next but obey $showHidden
  my ($win,$node,$top)= @_;
  my $tv = $win->treeView;
  $node=$node->following($top);
  while ($node) {
    return $node if ($tv->node_is_displayed($node));
    $node=$node->following($top);
  }
  return 0;
}

sub PrevDisplayed { # same as Next but obey $showHidden
  my ($win,$node,$top)= @_;
  my $tv = $win->treeView;
  $node=$node->previous($top);
  while ($node) {
    return $node if ($tv->node_is_displayed($node));
    $node=$node->previous($top);
  }
  return 0;
}

sub get_value_line {
  my ($win,$fsfile,$no,$no_numbers,$tags,$type)=@_;
  my $vl;
  if ($fsfile) {
    $vl=doEvalHook($win,"get_value_line_hook",$fsfile,$no,$type);
    if (defined($vl)) {
      if (ref($vl)) {
	unless ($tags) {
	  # important: encode inside - required by arabic, otherwise the text gets remixed
	  $vl = join EMPTY,map { encode($_->[0]) } @$vl;
	} else {
	  $vl=[ map { $_->[0]=encode($_->[0]); $_ } grep { $_->[0] ne EMPTY } @$vl ];
	}
      } else {
	$vl=encode($vl);
      }
    } else {
      $vl=$win->treeView->value_line($fsfile,$no,$no_numbers,$tags,$win);
    }
  } else {
    $vl=EMPTY;
  }
  return $vl;
}

sub reverseWrapLines {
  my ($widget,$font,$text,$width)=@_;
  use integer;
  my @toks;
  if (ref($text)) {
    @toks = @$text;
  } else {
    @toks = map { [$_,EMPTY] } split /\s+/, $text;
  }
  my @result;
  my $wd=0;
  my $w;
  my $t=pop(@toks);
  my @lines=();
  while ($t) {
    $w=$widget->fontMeasure($font," $t->[0]");
    if (($wd+$w>=$width) && (@result>0)) {
      push @lines, (@result,["\n",'space']);
      @result=($t);
      $wd=$widget->fontMeasure($font,$t->[0]);
    } else {
      $wd+=$w;
      unshift @result, $t;
    }
    $t=pop(@toks);
  }
  push @lines,@result;
  return \@lines;
}

sub set_value_line {
  my ($grp,$v)=@_;
  my $vl=$grp->{valueLine};
  $vl->configure(qw(-state normal));
  $vl->delete('0.0','end');
  my $rtl = $grp->{focusedWindow}->treeView->rightToLeft($grp->{focusedWindow}->{FSFile});
  if ($valueLineWrap eq 'word' and ($rtl or !defined($rtl) and $valueLineReverseLines)) {
    Tk::catch {
      $vl->configure(qw(-wrap none));
    };
    $v=reverseWrapLines($grp->{valueLine},$vLineFont,$v,
			$grp->{valueLine}->width()-15);
  } else {
    Tk::catch {
      $vl->configure(-wrap => ($valueLineWrap || 'word'));
    };
  }
  my @oldtags=grep {/^[a-zA-Z:]+=(?:HASH|ARRAY)/} $vl->tagNames();
  if (@oldtags) {
    $vl->tagDelete(@oldtags);
  }
  if (ref($v)) {
    my %tags;
    @tags{ map { @$_[1..$#$_] } @$v }=();
    foreach my $tag (keys(%tags)) {
      if ($tag=~/^\s*-/) {
	eval {
	  $vl->tagConfigure(
			    $tag => (map { (/^\s*(-[[:alnum:]]+)\s*=>\s*(.*\S)\s*$/) }  split(/,/,$tag)));
	};
	print $@ if $@;
      }
    }
    $vl->Subwidget('scrolled')->insert('end',EMPTY,undef,
				       map { ($_->[0], [reverse @$_[1..$#$_]]) } @$v);
  } else {
    $vl->Subwidget('scrolled')->insert('0.0',$v);
  }
  $vl->tagAdd('all','0.0','end');
  $vl->tagConfigure('all',-justify => (defined($rtl) ? ($rtl ? 'right' : 'left') : $valueLineAlign));
  $vl->configure(qw(-state disabled));
#   print "<dump>\n";
#   my @dump=$vl->dump('0.0','end');
#   while (@dump) {
#     my ($K,$V,$I) = (shift @dump, shift @dump, shift @dump);
#     if ($K eq 'tagon') { 
#       print "<tag value=\"$V\">";
#     } elsif ($K eq 'tagoff') {
#       print "</tag>";
#     } else {
#       print $V;
#     }
#   }
#   print "\n</dump>\n";
  return $v;
}

sub toggleSidePanel {
  my ($grp)=@_;
  unless (defined $grp->{sidePanelFrame}) {
    initSidePanel($grp);
  }
  if ($showSidePanel) {
    unless ($grp->{sidePanelPacked}) {
      $grp->{bodyPane}->add($grp->{sidePanelFrame},-before=>$grp->{windowFrame},-width=>$grp->{bodyPane}->width/6);
      $grp->{sidePanelPacked}=1;
    }
  } else {
    if ($grp->{sidePanelPacked}) {
      $grp->{bodyPane}->forget($grp->{sidePanelFrame});
      $grp->{sidePanelPacked}=0;
    }
  }
}



sub initSidePanel {
  my ($grp)=@_;
  require TrEd::SidePanel;
  unless ($grp->{sidePanel}) {
    $grp->{sidePanel}=TrEd::SidePanel->new($grp->{bodyPane});
    $grp->{sidePanelFrame} = $grp->{sidePanel}->frame();
  }
  unless ($grp->{sidePanel}->widget('attrsView')) {
    print STDERR "Creating 'Attribute' sidebar view\n" if $tredDebug;
    my $colf = $grp->{sidePanelFrame}->Frame(
      -relief => 'sunken',
      -borderwidth => 1,
     );
    my $cb = $colf->Checkbutton(
      -text => 'Hide empty values',
      -font => 'C_small',
      -underline => 2,
      -relief => 'flat',
      -anchor=>'nw',
      -justify => 'left',
	-command => sub {
	  if ($grp->{attrsViewPacked} and $grp->{sidePanelPacked}) {
	    update_attribute_view($grp->{focusedWindow});
	  }
	})->pack(-side=>'top',-fill=>'x');
    $grp->{top}->bind('my',"<Alt-d>", [sub{
					   my ($w,$grp)=@_;
					   if (defined(evalMacro($w,$grp,'ALT+'))) {
					     Tk->break;
					   } else {
					     toggle_attribute_view_hide_empty($grp);
					     Tk->break;
					   }
					 },$grp]);
    my $attrsView = $colf->TrEdNodeEditDlg({
      object=>undef,
      dialog => $colf,
      no_show=>1,
      no_sort=>!$sortAttrs,
      no_value_sort=>!$sortAttrValues,
      search_field => 0,
      hide_empty => 1,
      knit_support => 1,
      side_panel_wrap => $sidePanelWrap,
      TrEdNodeEdit=>{
	-takefocus=>0,
	-font => 'C_small',
	-borderwidth => 1,
	-selectborderwidth=>1,
	-scrollbars=>'soe',
	-itemstyle => {
	  -pady=>1,
	  -padx=>1,
	},
	-colors => {
	  bg => '#efefef',
	  constant => 'white',
	},
      },
      enable_callback => sub{ 0 },
      attribute_sort_callback => [ sub {
				     my ($grp,$array)=@_;
				     return doEvalHook($grp->{focusedWindow},'sort_attrs_hook',$array,'',$grp->{focusedWindow}{currentNode});
				   }, $grp ],
      no_focus => 1,
    });
    $cb->configure(-variable => \$attrsView->Subwidget('scrolled')->{userdata}{hide_empty});
    $grp->{sidePanel}->add('attrsView', $colf, { -label => 'Node Attributes',
						 -data => $attrsView->Subwidget('scrolled'),
						 -show_command => sub {
						   update_attribute_view($grp->{focusedWindow});
						  }
					       });
    $grp->{sidePanel}->widget('attrsView')->show;
  }
  unless ($grp->{sidePanel}->widget('filelistView')) {
    print STDERR "Creating 'File List' sidebar view\n" if $tredDebug;
    my $colf = $grp->{sidePanelFrame}->Frame(
      -relief => 'sunken',
      -borderwidth => 1,
     );
    my $t= $colf->Scrolled(qw/HList
			      -relief flat
			      -borderwidth 1
                              -selectborderwidth 1
			      -selectmode extended
			      -takefocus 0
			      -scrollbars soe/,
			      -separator=> "\t"
			     )
      ->pack(qw/-expand yes -fill both -side top/);
    my $hl = $t->Subwidget('scrolled');
    $hl->{balloonmsg} = '';
    $grp->{Balloon}->attach($hl,-msg => \$hl->{balloonmsg},
			    -initwait => 200,
			    -postcommand => sub {
			      my $w=shift;
			      my $y=$w->XEvent->y;
			      my $path = $w->nearest($y);
			      if (defined($path) and length($path)
				    and $w->infoExists($path)) {
				my @bbox = $w->infoBbox($path);
				if ($bbox[1]<$y and $y<$bbox[3]) {
				  $hl->{balloonmsg}=$w->infoData($path);
				  return 1;
				} else {
				  $hl->{balloonmsg}='';
				  return;
				}
			      }
			    }
			   );
    $hl->{default_style_imagetext}=$hl->ItemStyle(
      'imagetext',
      -padx=>1,
      -pady=>1,
      -foreground => 'black',
      -font => 'C_small',
     );
    $hl->{focused_style_imagetext}=$hl->ItemStyle(
      'imagetext',
      -padx=>1,
      -pady=>1,
      -foreground => 'blue',
      -selectforeground => 'blue',
      -font => 'C_small',
     );
    disable_scrollbar_focus($t);
    $t->BindMouseWheelVert();
    $grp->{sidePanel}->add('filelistView', $colf, {
      -label => 'Current File List',
      -data => $t,
      -show_command => sub {
	update_sidepanel_filelist_view($grp,$grp->{focusedWindow}{currentFilelist},1);
      }
     });
    my $open_callback = sub {
      my ($w,$grp)=@_;
      my $win = $grp->{focusedWindow};
      my $anchor=$w->info('anchor');
      my $nextentry=$w->info('next',$anchor);
      my $data=$w->info('data',$anchor);
      unless ($nextentry and $w->info('parent',$nextentry) eq $anchor) {
	# file -> go to
	$win->{currentFilelist}->set_current($data);
	my $pos = $win->{currentFilelist}->position;
	if ($pos>=0) {
	  gotoFile($win,$pos);
	}
      }
    };
    $t->bind('<Double-1>'=> [$open_callback, $grp]);
    my $menu = $t->Menu(
      -tearoff => 0,
      -menuitems => [
	['Button' => '~Open selected',
	 -command => [$open_callback,$t,$grp],
	],
	['Button' => '~Remove from filelist',
	 -command => [sub {
			my ($t,$grp)=@_;
			my $anchor=$t->info('anchor');
			my $fl =$grp->{focusedWindow}{currentFilelist};
			removeFromFilelist($grp,
					   $fl,
					   getFilelistLinePosition($fl, $anchor), $t->info('selection'));
			updateBookmarks($grp) if (ref($fl) and $fl->name eq 'Bookmarks');
		      },$t,$grp],
	],
      ]);
    $grp->{Balloon}->attach($menu,-msg => '');
    $t->bind('<3>', sub { my ($w)=@_;
			  $menu->Post($w->pointerxy);
			  Tk->break;
			});
    #$grp->{sidePanel}->widget('filelistView')->show;
  }
  unless ($grp->{sidePanel}->widget('fileSystemView')) {
    print STDERR "Creating 'Browse File System' sidebar view\n" if $tredDebug;
    my $show_hidden=0;
    my $colf = $grp->{sidePanelFrame}->Frame(
      -relief => 'sunken',
      -borderwidth => 1,
     );
    my $fsel= $colf->MyFileSelect(-selectmode=> 'extended',
				  -takefocus => 1,
				  -font => 'C_small',
				  -filetypes=> \@open_types)
      ->pack(qw/-expand yes -fill both -side top/);
     $fsel->Subwidget('filelist')->configure(-background => 'white', -takefocus=>0);
    my $open_callback = [sub {
			   shift if @_>2;
			   my ($grp,$fsel)=@_;
			   return if $fsel->ChDir();
			   my ($file) = $fsel->getSelectedFiles;
			   if (defined($file) and length($file)) {
			     openStandaloneFile($grp,$file);
			   }
			 },$grp,$fsel];
    $fsel->Subwidget('filelist')->bind('<Double-1>',$open_callback);
    my $menu = $fsel->Menu(
      -tearoff => 0,
      -menuitems => [
	['Button' => '~Open',
	 -command => $open_callback,
	],
	['Button' => '~Add To Filelist',
	 -command => [sub {
	   my ($grp,$fsel)=@_;
	   my @files = grep { defined && length} $fsel->getSelectedFiles;
	   insertToFilelist($grp->{focusedWindow}, undef,undef, @files) if @files;
	 },$grp,$fsel]
	],
	['Checkbutton' => '~Show hidden files',
	 -variable => \$show_hidden,
	 -command => [sub {
	   my ($grp,$fsel)=@_;
	   $fsel->configure(-showhidden=>$show_hidden);
	   $fsel->ReadDir($fsel->getCWD);
	 },$grp,$fsel]
	],
	['Cascade' => '~Filter',
	 -tearoff => 0,
	 -menuitems => [
	   map {
	     [ Button => $_->[0],
	       -command => [
		 sub {
		   my ($fsel,$filter)=@_;
		   $fsel->SetFilter('',$filter);
		 },$fsel,(ref($_->[1]) ? join(' ',@{$_->[1]}) : $_->[1])
		],
	      ]
	   } @open_types
	 ]
	],
      ]
    );
    $fsel->Subwidget('filelist')->bind('<3>', sub { my ($w)=@_; $menu->Post($w->pointerxy); Tk->break; });
    $grp->{sidePanel}->add('fileSystemView', $colf, {
      -label => 'Browse File System',
      -data => $fsel,
      -show_command => sub {
      }
    });
  }
  unless ($grp->{sidePanel}->widget('macroListView')) {
    print STDERR "Creating 'Macro List' sidebar view\n" if $tredDebug;
    my $colf = $grp->{sidePanelFrame}->Frame(
      -relief => 'sunken',
      -borderwidth => 1,
     );
    my $hl = createMacroList($grp,$colf,\$grp->{focusedWindow}{macroContext},
			     { -padx=>1,
			       -pady=>1,
			       -foreground => 'black',
			       -font => 'C_small',
			     }
			    )
      ->pack(qw/-expand yes -fill both -side top/);
    $hl->configure(-takefocus=>0);
    $grp->{macroListViewOrder}=$grp->{macroListOrder};
    my $menu = $hl->Menu(
      -tearoff => 0,
      -menuitems => [
	['Button' => 'Run selected macro',
	 -command => [sub {
			my ($grp,$t)=@_;
			my $anchor = $t->info('anchor');
			return unless $anchor;
			my $macro=$t->info(data => $anchor);
			doEvalMacro($grp->{focusedWindow},$macro) if defined $macro;
		      },$grp,$hl],
	],
	['Checkbutton' => '~Swap Key/Name',
	 -variable => \$grp->{macroListViewSwap},
	 -command => [\&update_macrolist_view,$grp],
	],
	['Checkbutton' => 'See ~Perl names',
	 -variable => \$grp->{macroListViewCalls},
	 -command => [\&update_macrolist_view,$grp],
	],
	['Checkbutton' => 'Include ~Anonymous Macros',
	 -variable => \$grp->{macroListViewAnonymous},
	 -command => [\&update_macrolist_view,$grp],
	],
	['Cascade' => '~Sort By',
	 -tearoff => 0,
	 -menuitems => [
	   map {
	   [ Radiobutton => $_->[0],
	     -variable => \$grp->{macroListViewOrder},
	     -value => $_->[1],
	     -command => [\&update_macrolist_view,$grp],
	   ]} (['~Key','K'],['~Name','M'],['~Perl name','P'])
	  ]
	],
      ]
    );
    $hl->bind('<3>', sub { my ($w)=@_; $menu->Post($w->pointerxy); Tk->break; });

    $grp->{sidePanel}->add('macroListView', $colf, {
      -label => 'List of Macros',
      -data => $hl,
      -show_command => [\&update_macrolist_view,$grp],
    });
  }
  print STDERR "Creating 'Macro List' sidebar view\n" if $tredDebug;
}

sub update_status_info {
  my ($win)=@_;
  update_status_line($win);
  $win->toplevel->afterIdle(sub{
			      update_attribute_view($win);
			    });
}

# sorts first by number of initial underscores, then alphabetically;
# the values are pased as array refs [ key, data ... ]
sub _u_sort {
  return
    map { $_->[2] }
    sort { ($b->[0]<=>$a->[0]) || ($a->[1] cmp $b->[1]) }
    map { $_->[0] =~ /^(_*)(.*)$/s && [ length($1), $2, $_ ] } @_;
}

sub update_context_list {
  my ($grp)=@_;
  if ($grp->{ContextsMenu}) {
    my $sel = $grp->{selectedContext};
    my %new = map { $_ => 1} getApplicableContexts($grp->{focusedWindow});
    my $tredmacro_ok = delete $new{TredMacro};
    $grp->{ContextsMenu}->configure(-options => [
      ($tredmacro_ok ? 'TredMacro' : ()),
      sort keys %new]);
    if ($sel ne $grp->{selectedContext}) {
      if ($tredmacro_ok) {
	$grp->{selectedContext} = 'TredMacro';
      } elsif ($opt_t and exists($new{$opt_t})) {
	$grp->{selectedContext} = $opt_t;
      }
      switchContext($grp->{focusedWindow},$grp->{selectedContext},1);
    }
  }
}

sub update_macro_menus {
  my ($grp)=@_;
  update_context_list($grp);
  if ($grp->{MacroMenu}) {
    my $menu = $grp->{MacroMenu}->menu;
    foreach my $context (sort(keys(%keyBindings))) {
      $menu->Cascade( -label => $context,
		      -menuitems=>
			cascadeMenus(map { $keyBindings{$context}->{$_}=~/(?:$context\-\>)?(.*)/;
					   [Button => $1,
					    -command=> [sub {
							  doEvalMacro($_[0]->{focusedWindow},
								      $_[1]);
						   },$grp,
							$keyBindings{$context}->{$_}],
					    -accelerator=> "($_)"
					   ]
					 } sort(keys(%{$keyBindings{$context}}))));
    }
  }
  my $tools_menu = $grp->{ToolsMenu}; #->menu;
  if ($grp->{UserMenu}) {
    my $menu = $grp->{UserMenu};
    $menu->delete(0,'end');
    $_->destroy for $menu->children;
    my $current;
    $grp->{MacroMenuItems}={}; # cache menus
    foreach my $context ("TredMacro",grep { $_ ne "TredMacro" } sort(keys(%menuBindings))) {
      my %macro_to_key = reverse %{ $keyBindings{$context}||{} };
      my $cascade = $menu->Cascade( -label => $context,
		 -menuitems=>
		   $grp->{MacroMenuItems}{$context}=cascadeMenus(map {
		     my $label = $_;
		     my $v = $menuBindings{$context}->{$label};
		     my $key = defined($v->[1]) ? $v->[1] : $macro_to_key{$v->[0]};
		     $label=~s/^_+//;
		     [Button=> $label,
		      -command=> [sub {
				    doEvalMacro($_[0]->{focusedWindow},
						$_[1]);
				  },
				  $grp,
				  $v->[0]],
		      $key ? (-accelerator=> "(".$key.")") : ()]}
                                  grep { $context ne 'TredMacro' or !/^_*\*/ } # skip "Star Tools" bindings
				  map $_->[1], _u_sort(map [$_,$_], keys(%{$menuBindings{$context}}))));
      $current = $cascade if $context eq $grp->{focusedWindow}{macroContext}
    }
    # $tools_menu->entryconfigure('Current Context*',-menu => $current->menu);
  }
  if ($tools_menu) {
    # update "Star Tools" in the Tools menu
    print STDERR "updating toolmenu\n" if $tredDebug;
    my $end = $tools_menu->index('end');
    my ($first,$last);
    for (my $i=0; $i<$end; $i++) {
      if ($tools_menu->type($i) eq 'command' and $tools_menu->entrycget($i,'-label') =~ /^\*/) {
	$first = $i unless defined $first;
	$last = $i;
      } elsif (defined $first) {
	last;
      }
    }
    # print STDERR "clearing toolmenu from $first to $last\n" if defined($first) and $tredDebug;
    $tools_menu->delete($first,$last) if (defined $first);
    my $TredMacroMenu = $menuBindings{TredMacro};
    my %macro_to_key = reverse %{ $keyBindings{TredMacro}||{} };
    $first ||= 'end';
    foreach my $item (map $_->[1], _u_sort(map [$_,$_], grep /^_*\*/, keys %$TredMacroMenu)) {
      my $v = $TredMacroMenu->{$item};
      my $key = defined($v->[1]) ? $v->[1] : $macro_to_key{$v->[0]};
      my $label = $item; $label=~s/^_+//;
      # print STDERR "appending toolmenu $first\n" if $tredDebug;
      $tools_menu->insert($first,
			  'command',
			  -label => $label,
			  -command=> [sub { doEvalMacro($_[0]->{focusedWindow}, $_[1]); },
				      $grp,
				      $v->[0]],
			  $key ? (-accelerator=> "(".$key.")") : ());
      $first ++;
    }
  }
  updateCurrentContextMenu($grp);
}

sub updateCurrentContextMenu {
  my ($grp)=@_;
  print STDERR "updating context menu\n" if $tredDebug;
  my $context = $grp->{focusedWindow}{macroContext};
  my $menu = $grp->{CurrentContextMacroMenu};
  eval {
    # if ($M->isa('Tk::Menubutton')) {
    #   $M->configure(-text => "$context");
    # } else {
    #   $M->configure(-label => "$context");
    # }
    # my $menu = $M->menu;
    $menu->delete(0,'end');
    $_->destroy for $menu->children;
    if ($menuBindings{$context}) {
#      $M->configure(-state=>'normal');
      $menu->AddItems(@{$grp->{MacroMenuItems}{$context}});
    } else {
#      $M->configure(-state=>'disabled');
    }
  };
  warn $@ if $@;
}

sub update_macrolist_view {
  my ($grp,$win) = grp_win($_[0]);
  return if $grp->{noUpdateMacrolistView};
  my $view = $grp->{sidePanel} && $grp->{sidePanel}->widget('macroListView');
  return unless $view and $view->is_shown;
  my $hl=$view->data;
  macrolistCreateItems($grp,$hl,
		       $grp->{selectedContext},
		       $grp->{macroListViewAnonymous},
		       $grp->{macroListViewCalls},
		       $grp->{macroListViewOrder},
		       $grp->{macroListViewSwap},
		      );
}
sub update_attribute_view {
  my ($grp,$win) = grp_win($_[0]);
  my $view = $grp->{sidePanel} && $grp->{sidePanel}->widget('attrsView');
  return unless $view and $view->is_shown;
  my $attrsView=$view->data;
  return unless ref $attrsView;
  my $current = $win->{currentNode};
  $attrsView->set_option('no_sort'=>!$sortAttrs);
  $attrsView->set_option('no_value_sort'=>!$sortAttrValues);
  $attrsView->set_data({
    type => ref($current) && $current->type,
    object => $current,
  });
}
sub toggle_attribute_view_hide_empty {
  my ($grp)=@_;
  my $view = $grp->{sidePanel} && $grp->{sidePanel}->widget('attrsView');
  return unless $view and $view->is_shown;
  my $attrsView=$view->data;
  return unless ref $attrsView;
  $attrsView->{userdata}{hide_empty}=!$attrsView->{userdata}{hide_empty};
  update_attribute_view($grp->{focusedWindow});
}

sub update_status_line {
  my ($win)=@_;
  return unless $win;
  return unless $displayStatusLine;
  my $l=doEvalHook($win,"get_status_line_hook");
  set_status_line($win->{framegroup},$l);
}

sub set_status_line {
  my ($grp,$text)=@_;
  my $sl=$grp->{statusLine};
  return unless $sl;
  $sl->configure(qw(-state normal));
  $sl->delete('0.0','end');
  my @oldtags=$sl->tagNames();
  if (@oldtags) {
    $sl->tagDelete(@oldtags);
  }
  unless ($grp->{statusLineText} eq EMPTY) {
    $sl->insert('end',encode($grp->{statusLineText}),undef);
    $sl->insert('end'," | ",undef) if ($text);
  }
  if (ref($text)) {
    my ($fields,$styles)=@$text;
    my $i=0;
    my @fields = map { $i=!$i; $i ? encode($_) : $_ } @$fields;
    $sl->insert('end',@fields) if @fields;
    while (@$styles) {
      my $style=shift @$styles;
      my $opts=shift @$styles;
      $sl->tagConfigure($style, @$opts);
    }
  } else {
    $sl->insert('0.0',encode($text));
  }
#  $sl->tagAdd('all','0.0','end');
#  $sl->tagConfigure('all');
  $sl->configure(qw(-state disabled));
  return $text;
}

sub update_tree_pos {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow}; # only focused window uses the value line
  if ($win->{FSFile}) {
    $grp->{vLineNumLabel}->configure(-text => ($win->{treeNo}+1)."/".($win->{FSFile}->lastTreeNo+1));
  } else {
    $grp->{vLineNumLabel}->configure(-text => "-/-");
  }
#  $grp->{vLineNumLabel}->update();
}

sub update_value_line {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow}; # only focused window uses the value line
  return if $win->{noRedraw};
  update_tree_pos($grp);
  my $vl = set_value_line($grp,get_value_line($win,$win->{FSFile},
					    $win->{treeNo},1,1,'value_line'));
  update_value_line_current($win,$win->{currentNode});
  return $vl;
}

### Get Nodes

sub get_nodes_win {
  my ($win,$noredraw)=@_;
  if ($win->{FSFile}) {
    $TrEd::TreeView::on_get_nodes = [\&onGetNodes,$win];
    $win->{treeNo}=0 if ($win->{treeNo}<0 and $win->{FSFile}->lastTreeNo>=0);
    $win->{root}=$win->{FSFile}->treeList->[$win->{treeNo}];
    ($win->{Nodes},$win->{currentNode})= $win->treeView->nodes($win->{FSFile},
								 $win->{treeNo},
								 $win->{currentNode});
  } else {
    print "no nodes to get\n" if $tredDebug;
    $win->{root}=undef;
    $win->{Nodes}=[];
    $win->{currentNode}=undef;
  }
  update_value_line($win->{framegroup}) if (isFocused($win) and !$noredraw);
}

sub get_nodes_fsfile {
  my ($grp,$fsfile)=@_;
  return if $insideEval;
  foreach my $w (fsfileDisplayingWindows($grp,$fsfile)) {
    get_nodes_win($w);
  }
  return;
}

sub get_nodes_fsfile_tree {
  my ($grp,$fsfile,$tree_no,$no_redraw)=@_;
  return if $insideEval;
  foreach my $w (grep {$_->{treeNo} == $tree_no}
	   fsfileDisplayingWindows($grp,$fsfile)) {
    get_nodes_win($w,$no_redraw);
  }
  return;
}

sub get_nodes_stylesheet {
  my ($grp,$stylesheet)=@_;
  return if $insideEval;
  foreach (stylesheetUsingWindows($grp,$stylesheet)) {
    get_nodes_win($_);
  }
  return;
}


sub get_nodes_all {
  my ($grp)=@_;
  foreach my $w (@{ $grp->{treeWindows} }) {
    get_nodes_win($w);
  }
  return;
}

############################################################
############################################################
############################################################
# Filelists
############################################################

sub selectFilelistNoUpdate {
  my ($grp_or_win,$list_name,$noResetPosition)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $fl= isFocused($win) ? switchFilelist($grp,$list_name) : findFilelist($list_name);
  print "Selecting filelist '$list_name' (found: $fl)\n" if $tredDebug;
  return unless defined($fl);
  unless ($fl == $win->{currentFilelist}) {
    # save file position in the current file-list
    # before switching
    $win->{currentFilelist}->set_current(filelistFullFileName($win,$win->{currentFileNo}))
      if ref($win->{currentFilelist});
    $win->{currentFilelist}=$fl;
  }
  $win->{currentFileNo}=max2(0,$fl->position()) unless $noResetPosition;
  return $fl;
}

sub selectFilelist {
  my ($grp_or_win,$list_name,$opts)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $fl = selectFilelistNoUpdate($win,$list_name);
  if ($fl and !$opts->{no_open}) {
    if ($win->{currentFileNo}>=$fl->file_count()) {
      closeFile($win);
    } else {
      # we use nextFile instead of gotoFile so that
      # the user can 'Skip broken files'
      $win->{currentFileNo}--;
      nextFile($win);
    }
    updateTitle($grp);
    update_sidepanel_filelist_view($grp,$fl,1);
  }
  return $fl;
}

# Find named filelist. Return undef if no such filelist exists
sub findFilelist {
  my ($name)=@_;
  for (@filelists) {
    return $_ if ($_->name eq $name);
  }
  return undef;
}

sub looseFilePositionInFilelist {
  my ($filelist,$fsfile) = @_;
  return undef unless ref($filelist);
  my $fname = ref($fsfile) ? $fsfile->filename() : $fsfile;
  my $pos = $filelist->position($fsfile);
  return $pos if $pos >= 0;

  ($fname)=parseFileSuffix($fname);
  my $files=$filelist->files_ref;
  my $basedir=$filelist->dirname();
  my $relfname=$fname;
  if (index($fname,$basedir)==0) {
    $relfname=substr($fname,length($basedir));
  }
  for (my $i=0; $i < $filelist->file_count; $i++) {
    my ($fn) = parseFileSuffix($files->[$i]->[0]);
    return $i if ($fname eq $fn or $relfname eq $fn);
  }
  return -1;
}



# this is only a local switch inside the file list dialog window,
# but returns filelist of a given name as a by-product
sub switchFilelist {
  my ($grp,$list_name)=@_;
  print "Switching filelist to '$list_name'\n" if $tredDebug;
  return undef unless ref($grp);
  my $fl=undef;
  if (ref($list_name)) {
    $fl=$list_name;
    $list_name=$fl->name();
  }
  return $grp->{filelistCurrentFilelist} 
    if (ref($grp->{filelistCurrentFilelist}) and 
	$list_name eq $grp->{filelistCurrentFilelist}->name);
  $fl=findFilelist($list_name) unless ($fl);
  return undef unless $fl;
  if ($grp->{Filelist}) {
    $grp->{filelistCurrentFilelist}=$fl;
    update_a_filelist_view($grp,$grp->{Filelist},$fl,0,1);
    if (defined($fl->current)) {
      update_a_filelist_view($grp,$grp->{Filelist},$fl, max2(0,$fl->position),0);
    }
    $grp->{Filelist}->update();
  }
  return $fl;
}


sub createFilelistBrowseEntry {
  my ($grp,$w,$filelistref)=@_;
  my $ll= $w->BrowseEntry
    (
     -label=> 'File lists:',
     -variable=> $filelistref,
     -browsecmd=>
     [
      sub {
	my ($grp,$list,$l)=@_;
	switchFilelist($grp,$$list);
      },$grp,$filelistref
     ],
     -listcmd=>
     [ sub {
	 my $l=shift;
	 $l->delete(0,'end');
	 foreach (sort {lc($a->name()) cmp lc($b->name())} @filelists) {
	   $l->insert(0,$_->name);
	 }
       }]
    );
  $ll->Subwidget('entry')->bind
    ('<Return>',
     [ sub {
	 my ($w, $grp, $fl)=@_;
	 my $text=$w->get;
	 if (findFilelist($text)) {
	   switchFilelist($grp,$text);
	 } else {
	   return unless $text ne EMPTY;
	   my $d=$w->toplevel->
	     Dialog(-text=> "File-list named $text does not exist.\n".
		    "Do you want to create new filelist or rename current?",
		    -bitmap=> 'question',
		    -title=> 'Create/Rename?',
		    -buttons=> ['Create', 'Rename', 'Cancel']);
	   $d->BindReturn($d,1);
	   $d->BindButtons;
	   my $answer=$d->Show();
	   if ($answer eq 'Create') {
	     addFilelist(Filelist->new($text));
	     switchFilelist($grp,$text);
	     updatePostponed($grp);
	   } elsif ($answer eq 'Rename') {
	     my $oldn=$grp->{filelistCurrentFilelist}->name();
	     $grp->{filelistCurrentFilelist}->rename($text);
	     updateBookmarks($grp)
	       if ($oldn eq 'Bookmarks');
	     $$fl=$text;
	     updatePostponed($grp);
	   } else {
	     $$fl=$grp->{filelistCurrentFilelist}->name
	       if ($grp->{filelistCurrentFilelist});
	   }
	 }
       },$grp,$filelistref ]);
  $ll->Subwidget('entry')->Subwidget('entry')->configure(qw/-background white -foreground black/);
  $ll->Subwidget('slistbox')->configure(qw/-background white -foreground black/);
  return $ll;
}

sub addFilelist {
  my ($fl)=@_;
  push @filelists, $fl;
  print "adding filelist ".$fl->name()."\n";
  return $fl;
}

sub getFilelistLinePosition {
  my ($fl,$line)=@_;
  return undef unless ref($fl);
  my ($p,$f)=split /\t/,$line;
  return Index($fl->list_ref,$p);
}

sub insertToFilelist {
  my ($grp_or_win,$filelist,$position)=(shift,shift,shift);
  my ($grp,$win)=grp_win($grp_or_win);
  $filelist=$win->{currentFilelist} unless defined($filelist);
  $position=$win->{currentFileNo} unless defined($position);
  return -1 unless ref($filelist) and UNIVERSAL::can($filelist,'add');


  print "Insert: ",@_," ",$_[0]," is at position ",$filelist->position($_[0]),"\n"  if $tredDebug;
  return -1 if (@_==1 and $filelist->position($_[0])>=0);
  # this is the case when we add a file which is actually already there

  my @list=map absolutize($_),@_;
  my $tmp;
  my $toplevel= $grp->{Filelist} ? $grp->{Filelist}->toplevel : $grp->{top};
  @list= map {
    if (-d $_) {
      $grp->{'hist-fileListPattern'}=[] unless $grp->{'hist-fileListPattern'};
      $tmp=Query($toplevel,"Selection Pattern","Insert pattern for directory $_","*.*",1,$grp->{'hist-fileListPattern'});
      $_= defined($tmp) ? File::Spec->catfile($_,$tmp) : undef;
    }
    $_;
  } @list;
  $position = min($position+1, $filelist->count)-1;
  print "Inserting @list to position ",$position+1,"\n" if $tredDebug;
  $filelist->add($position+1,@list);

  update_filelist_views($grp,$filelist,1);
  if ($grp->{Filelist} and $grp->{filelistCurrentFilelist} == $filelist) {
    $position = max2(0,$filelist->position($list[0]));
    update_a_filelist_view($grp,$grp->{Filelist},$filelist,$position,0);
    # select all files resulting from an added patterns
    for (my $i=0 ; $i<$filelist->file_count ; $i++) {
      if (defined(Index(\@list,$filelist->file_pattern($i)))) {
	my $file = filelistEntryPath($filelist,$i);
	if ($grp->{Filelist}->info('exists',$file)) {
	  $grp->{Filelist}->selectionSet($file);
	}
      }
    }
  }
  return $position+1;
}

sub removeFromFilelist {
  my ($grp_or_win,$filelist,$position)=(shift,shift,shift);
  unless (@_) {
    print STDERR "removeFromFilelist: no file given\n";
    return;
  }

  my ($grp,$win)=grp_win($grp_or_win);
  $filelist=$win->{currentFilelist} if not defined($filelist);
  $position=$win->{currentFileNo} if not defined($position);
  return unless ref($filelist) and UNIVERSAL::can($filelist,'remove');
  
  $filelist->remove(@_);
  if ($filelist eq $win->{currentFilelist}) {
    $win->{currentFileNo}= min($win->{currentFileNo},
			       $filelist->file_count-1);
  }

  update_filelist_views($grp,$filelist,1);
  if ($grp->{Filelist} and $grp->{filelistCurrentFilelist} == $filelist) {
    $position=min2($position,$filelist->file_count-1);
    update_a_filelist_view($grp,$grp->{Filelist},$filelist,$position,0);
  }
}

sub createNewFilelist {
  my ($grp,$top)=@_;
  my $name = QueryString($top || $grp,"File-list name", "Name: ") || return;
  if ($top) {
    $top->deiconify; $top->focus; $top->raise;
  }
  if (findFilelist($name)) {
    userQuery($top || grp_win($grp),
	      "File-list named '$name' already exists.\n",
	      -title => "File-list already exists",
	      -buttons => ["OK"]);
    return;
  } else {
    my $fl = Filelist->new($name);
    addFilelist($fl);
    switchFilelist($grp,$fl->name);
    updatePostponed($grp);
    return $fl;
  }
}

sub addNewFilelist {
  my ($grp,$fl,$top)=@_;
  return if not defined($fl) or $fl eq EMPTY;
  my $l;
  my $old_name = eval { $fl->name };
  if ($@) {
    confess($@)
  }
  LOOP:
  for my $dummy (1) {
    ($l) = grep { $_->name eq $fl->name } @filelists;
    last unless $l;
    if ($top) {
      my $answer = 
	Treex::PML::IO::is_same_file($l->filename,$fl->filename)
	  ? userQuery($top,
		      "Filelist '".$fl->name."' already loaded.\n",
		      -bitmap=> 'question',
		      -title => "Reload filelist?",
		      -buttons => ['Reload','Cancel'])
	  : userQuery($top,
		      "Filelist named '".$fl->name.
			"' is already loaded from\n".$l->filename."\n",
		      -bitmap=> 'question',
		      -title => "Filelist confilct",
		      -buttons => ['Replace','Change name','Cancel']);
      return $l if $answer eq 'Cancel';
      if ($answer eq 'Change name') {
	my $name = QueryString($top,"Filelist name", "Name: ",$fl->name);
	return $l unless defined($name);
	$fl->rename($name);
	redo LOOP;
      }
    } elsif ($tredDebug) {
      print STDERR "Filelist ",$fl->name," already exists, replacing!\n";
    }
  }
  if ($old_name ne $fl->name) {
    print STDERR "Saving filelist ".$fl->name." to: ",$fl->filename,"\n" unless $opt_q;
    $fl->save; # filelist renamed
  }
  if ($l) {
      @{ $l->list_ref }= $fl->list;
      $l->filename($fl->filename); # set filename
      $l->expand;
      if ($grp) {
	$grp->{filelistCurrentFilelist}=undef;
	switchFilelist($grp,$l);
      }
      undef $fl;
      return $l;
  }
  if (not defined($fl->name) or $fl->name eq EMPTY) {
    undef $fl;
    return;
  }
  push @filelists, $fl;
  if ($grp) {
    switchFilelist($grp,$fl);
    updatePostponed($grp);
  }
  return $fl;
}

sub deleteFilelist {
  my ($grp,@lists)=@_;
  @lists = grep {
    (ref($_) ? (($filelist_from_extension{$_}||0)!=1) : do { carp("deleteFilelist: $_ is not a filelist object!"); 0 })
    and $_->name !~ /^(Default|Bookmarks)$/
  } @lists;
  my %to_delete; @to_delete{ @lists } = ();
  return unless @lists;
  print "Removing filelists ".join(",",map $_->name(), @lists)."\n" if $tredDebug;
  @filelists=grep(!exists($to_delete{$_}), @filelists);
  for my $list (@lists) {
    if (($filelist_from_extension{$list}||0)==2) {
      my $fn = $list->filename;
      if ($fn) {
	print "Deleting filelist file $fn\n" if $tredDebug;
	unlink $fn;
      }
    }
  }
  if (exists($to_delete{$grp->{filelistCurrentFilelist}})) {
    $grp->{filelistCurrentFilelist}=undef;
    switchFilelist($grp,'Default');
  }
  undef @lists;
  updatePostponed($grp);
}

sub filelistEntryPath {
  my ($fl,$index)= @_;
  return undef unless ref($fl);

  my $f= $fl->file_at($index);
  my $p= $fl->file_pattern($index);
  return $f eq $p ? $f : "$p\t$f";
}

sub feedHListWithFilelist {
  my ($grp,$hl,$fl)=@_;
  return unless ref($hl) and ref($fl);
  if ($hl->can('Subwidget') and $hl->Subwidget('scrolled')) {
    $hl=$hl->Subwidget('scrolled');
  }
  $hl->delete('all');
  my $pat;
  my $f;
  for(my $i=0;$i<$fl->file_count;$i++) {
    $pat=$fl->file_pattern($i);
    $f=$fl->file_at($i);
    next unless defined($pat) and defined($f);
    if ($pat eq $f) {
      $hl->add($f,
	       -itemtype=> 'imagetext',
	       -image=> $grp->{fileImage},
	       -data=> $f,
	       -text=> $f,
	       -style => $hl->{default_style_imagetext},
	      );
      next;
    }
    unless ( $hl->info('exists', $pat) ) {
      $hl->add("$pat",
	       -itemtype=> 'imagetext',
	       -image=> $grp->{folderImage},
	       -data=> $pat,
	       -text=> $pat,
	       -style => $hl->{default_style_imagetext},
	      );
    }
    $hl->add("$pat\t$f",
	     -itemtype=> 'imagetext',
	     -image=> $grp->{fileImage},
	     -data=> $f,
	     -text=> $f,
	     -style => $hl->{default_style_imagetext},
	    );
  }
}


sub selectFilelistDialog {
  my ($grp)=@_;
  use Devel::Peek;
  for (@filelists) {
    #Dump($_->name);
  }
  my @lists =
    sort { $a->[2] cmp $b->[2] } (map { [$_,$_->name,lc($_->name)] } @filelists);
  return unless @lists;
  my $i = 'A';
  my $selection = [$i.'.  '.$lists[0]->[1]];
  listQuery($grp->{top},'Select File Lists','browse',
	    [map { ($i++).".  ".$_->[1] } @lists],$selection,
	   ) || return;
  return unless (@$selection);
  my $sel = $selection->[0];
  $sel=~s{^\w+.  }{};
  selectFilelist($grp,$sel);
}

sub bookmarkToFilelistDialog {
  my ($grp)=@_;
  my @lists = sort { $a->[2] cmp $b->[2] } grep {($filelist_from_extension{$_->[0]}||0)!=1} map [$_,$_->name,lc($_->name)], @filelists;
  return unless @lists;
  my $i = 'A';
  my $selection = [$i.'.  '.$lists[0]->[1]];
  listQuery($grp->{top},'Add Bookmark To File Lists','browse',
	    [map {($i++).'.  '.$_->[1]} @lists],$selection,
	   ) || return;
  return unless (@$selection);
  my $sel = $selection->[0];
  $sel=~s{^\w+.  }{};
  addBookmark($grp,$sel);
}

sub removeFilelistsDialog {
  my ($grp)=@_;

  my @lists = sort { $a->[1] cmp $b->[1] }  grep { $_->[1] ne 'Default' and $_->[1] ne 'Bookmarks' and 
		    ($filelist_from_extension{$_->[0]}||0)!=1} map [$_,$_->name,lc($_->name)], @filelists;
  return unless @lists;
  my $i = 'A';
  my $selection = [$i.'.  '.$lists[0]->[1]];
  my $indexes = listQuery($grp->{top},'Remove File Lists','extended',
		  [map {($i++).'.  '.$_->[1]} @lists],$selection,
		  {
		    -label => 'Select one or more file lists',
		  }) || return;
  return unless (@$selection and
		 userQuery($grp->{top},
			  "Realy remove ".scalar(@$selection)." file list(s)?\n",
			  -bitmap=> 'question',
			  -title => "Remove file lists?",
			  -buttons => ['Remove','Cancel']) eq 'Remove');
  deleteFilelist($grp,map $_->[0], @lists[@$indexes]);
}

sub loadFilelist {
  my ($grp,$top)=@_;
  $top||=$grp->{top};
  my $file= get_open_filename($top,-filetypes=>
				[["Filelists",           ['.fl']],
				 ["All files",           ['*','*.*']]
				],
			      -title=> "Load filelist ...");
  $top->deiconify;
  $top->focus;
  $top->raise;
  return unless (defined $file and $file ne EMPTY);
  my $fl=Filelist->new(undef,$file);
  return unless $fl;
  print STDERR "Loading filelist: $file\n";
  $fl->load();
  addNewFilelist($grp,$fl,$top);
  return $fl->name();
}

sub filelistDialog {

  use Tk::LabFrame;
  my ($grp,$modal)=@_;
  my $win = $grp->{focusedWindow};
  if (defined($grp->{Filelist})) {
    if ($modal) {
      ShowDialog($grp->{Filelist}->toplevel);
    } else {
      $grp->{Filelist}->toplevel->deiconify;
      $grp->{Filelist}->toplevel->focus;
      $grp->{Filelist}->toplevel->raise;
    }
    return;
  }
  return if ($grp->{Filelist});

  $grp->{top}->Busy(-recurse=>1);
  my $filelist;
  if (!ref($win->{currentFilelist})) {
    if ($win->{FSFile}) {
      errorMessage($win,"Cannot manage file-lists while visiting a file not belonging to any file-list! ".
		   "Please, switch to a file-list (e.g. using Session->Default) and try again.",1);
      $grp->{top}->Unbusy();
      return;
    } else {
      selectFilelist($grp,'Default');
    }
  }
  $grp->{filelistCurrentFilelist}=$win->{currentFilelist};
  $filelist=$grp->{filelistCurrentFilelist}->name;
  my $d= $grp->{top}->Toplevel(-title=> "Filelist");
  $d->withdraw;
  $grp->{filelistDialog}=$d;

  my $botframe=$d->Frame()->pack(qw/-fill both -side bottom/);
  my $topframe=$d->Frame()->pack(qw/-fill both -side top -expand 1/);

  my $labframe=$topframe->LabFrame(-label=> 'Files to add',
				-labelside=> 'acrosstop'
			       )->pack(qw/-expand no -fill both -side left/);
  $labframe->Subwidget('label')->configure(-underline => 0);
  my $fsel= $labframe->MyFileSelect(
    -selectmode=> 'extended',
    -takefocus => 1,
    -textentry => 1,
   )->pack(qw/-expand yes -fill both -side left -padx 5 -pady 5/);
  $fsel->Subwidget('filelist')->configure(-background => 'white', -setgrid => 1);
  my $show_hidden=0;
  my $menu = $fsel->Menu(
    -tearoff => 0,
    -menuitems => [
      ['Checkbutton' => '~Show hidden files',
       -variable => \$show_hidden,
       -command => [sub {
		      my ($grp,$fsel)=@_;
		      $fsel->configure(-showhidden=>$show_hidden);
		      $fsel->ReadDir($fsel->getCWD);
		    },$grp,$fsel]
      ],
      ['Cascade' => '~Filter',
       -tearoff => 0,
       -menuitems => [
	 map {
	     [ Button => $_->[0],
	       -command => [
		 sub {
		   my ($fsel,$filter)=@_;
		   $fsel->SetFilter('',$filter);
		 },$fsel,(ref($_->[1]) ? join(' ',@{$_->[1]}) : $_->[1])
		],
	      ]
	   } @open_types
	  ]
      ],
     ]
   );
  $fsel->Subwidget('filelist')->bind('<3>', sub { my ($w)=@_; $menu->Post($w->pointerxy); Tk->break; });
  
  $d->bind("<Alt-f>",[$fsel->Subwidget('filelist')->Subwidget('scrolled'),'focus']);

  my $leftframe=$topframe->Frame();
  my $midframe=$topframe->Frame();
  my $rightframe=$topframe->Frame();

  my $ll= createFilelistBrowseEntry($grp,$rightframe,\$filelist);
  $ll->pack(qw/-expand no -fill x -side top/);

  # Bloody hell, how do I underline BrowseEntry labels?
  foreach (grep { ref($_) and $_->isa('Tk::Label') } get_widget_descendants($ll)) {
    $_->configure( -underline => 1 );
  }
  $d->bind("<Alt-i>",[$ll->Subwidget('entry'),'focus']);
  $grp->{Balloon}->attach($ll,-balloonmsg=>
			  "Select a file-list to display.\nTo rename the selected file-list, type in a new name and press Enter.");

  my $t= $rightframe->Scrolled(qw/HList -relief sunken
				  -selectmode extended
				  -font C_small
				  -scrollbars oe/,
			       -separator=> "\t"
			      )
    ->pack(qw/-expand yes -fill both -side top/);
  disable_scrollbar_focus($t);
  $t->BindMouseWheelVert();
  $grp->{Filelist}=$t;
  feedHListWithFilelist($grp,$t,$grp->{focusedWindow}->{currentFilelist});

  my @pad = qw(-padleft 7 -padright 7 -padmiddle 5 );
  my @b_pack = qw(-padx 0.1c -pady 0.2c -side right);
  $midframe->ImgButton(-text=> 'Add',
		       -image => icon($grp,"1rightarrow"),
		       @pad,
		       -underline=> 0,
		       -balloon => $grp->{Balloon},
		       -balloonmsg=> "Add files selected on the left\nto the file-list on the right.",
		       -command=>[
				  sub {
				    my ($grp,$t,$l)=@_;
				    my $anchor = $t->info('anchor');
				    my $pos =
				      defined($anchor) ?
				      getFilelistLinePosition($grp->{filelistCurrentFilelist},
							      $anchor) : 0;
				    insertToFilelist($grp,
						     $grp->{filelistCurrentFilelist},
						     $pos,
						     $l->getSelectedFiles
						    );
				    updateBookmarks($grp)
				      if (ref($grp->{filelistCurrentFilelist}) and
					  $grp->{filelistCurrentFilelist}->name eq 'Bookmarks');
				  },$grp,$t,$fsel])->pack(qw/-fill x -expand yes -pady 0.2c -side top/);

  $midframe->ImgButton(-text=> 'Remove',
		       -image => icon($grp,"1leftarrow"),
		       @pad,
		       -underline=> 0,
		       -balloon => $grp->{Balloon},
		       -balloonmsg=> "Remove selected files on the right from the file-list.",
		       -underline=> 4,
		       -command=>[
			       sub { 
				 my ($grp,$t)=@_;
				 removeFromFilelist($grp,
						    $grp->{filelistCurrentFilelist},
						    getFilelistLinePosition($grp->{filelistCurrentFilelist},
									    $t->info('anchor')),
						    $t->info('selection'));
				 updateBookmarks($grp)
				   if (ref($grp->{filelistCurrentFilelist}) and
				       $grp->{filelistCurrentFilelist}->name eq 'Bookmarks');
			       },$grp,$t])->pack(qw/-fill x -expand yes -pady 0.2c -side top/);

  unless ($modal) {
    $midframe->ImgButton(-text=> 'Show in TrEd',
			 -image => icon($grp,"button_ok"),
		      -balloon => $grp->{Balloon},
		      -balloonmsg=> "Open the file-list on the selected position.",
		      @pad,
		      -underline=> 0,
		      -command=> [ sub {
				     my ($grp)=@_;
				     $grp->{filelistCurrentFilelist}->
				       set_current($grp->{Filelist}->
						   info('data',$grp->{Filelist}->info('anchor')));
				     selectFilelist($grp,$grp->{filelistCurrentFilelist});
				   },$grp ])->pack(qw/-fill x -expand yes -pady 0.2c -side top/);
    $t->bind('<Return>'=> [
			    sub {
			      my ($w,$grp)=@_;
			      my $anchor=$grp->{Filelist}->info('anchor');
			      my $nextentry=$grp->{Filelist}->info('next',$anchor);
			      unless ($nextentry and
					$grp->{Filelist}->info('parent',$nextentry) eq $anchor) {
				$grp->{filelistCurrentFilelist}->
				  set_current($grp->{Filelist}->
					      info('data',$grp->{Filelist}->info('anchor')));
				selectFilelist($grp,$grp->{filelistCurrentFilelist});
			      }
			    },$grp]);
    $t->bind('<Double-1>'=> [
			      sub {
				my ($w,$grp)=@_;
				my $anchor=$grp->{Filelist}->info('anchor');
				my $nextentry=$grp->{Filelist}->info('next',$anchor);
				my $data=$grp->{Filelist}->info('data',$anchor);
				if ($nextentry and
					$grp->{Filelist}->info('parent',$nextentry) eq $anchor) {
				  # pattern -> edit
				  my $position=
				    $grp->{filelistCurrentFilelist}->find_pattern($data);
				  $grp->{'hist-fileListPattern'}=[] unless $grp->{'hist-fileListPattern'};
				  $data=Query($grp->{Filelist}->toplevel,"Selection Pattern",
					"Edit directory pattern for $data",$data,1,$grp->{'hist-fileListPattern'});
				  if (defined($data)) {
				    print "Removing ",$grp->{Filelist}->info('data',$anchor),"\n" if $tredDebug;
				    $grp->{filelistCurrentFilelist}->remove($grp->{Filelist}->info('data',$anchor));
				    print "Adding $data\n" if $tredDebug;
				    $grp->{filelistCurrentFilelist}->add($position,$data);
				    feedHListWithFilelist($grp,$grp->{Filelist},$grp->{filelistCurrentFilelist});
				  }
				} else {
				  # file -> go to
				  $grp->{filelistCurrentFilelist}->set_current($data);
				  selectFilelist($grp,$grp->{filelistCurrentFilelist});
				}
			      },$grp ]);
  }
  $d->bind('<Destroy>'=> [sub { shift;
				 my $grp=shift;
				 $grp->{Filelist}=undef;
				 $grp->{filelistCurrentFilelist}=undef;
			       },$grp ]);
  $d->bind($d,'<Escape>'=>
	   [sub { shift;
		  $modal ?
		    shift->{selected_button}= "Cancel" :
		      shift->destroy();
		},$d ]);

  $botframe->ImgButton(-text => 'Close',
	     -image => icon($grp,"button_cancel"),
	     -balloon => $grp->{Balloon},
	     -balloonmsg => "Close this window.",
	     -underline=> 0,
	     @pad,
	     -command=> [sub {
			   $modal ?
			     shift->{selected_button}= "Cancel" :
			       shift->destroy();
			 },$d ])
    ->pack(@b_pack);

  $botframe->ImgButton(-text=> 'Delete',
		-image=> icon($grp,"editdelete"),
		-balloon => $grp->{Balloon},
		-balloonmsg=> "Delete current file-list.",
		@pad,
		-underline=> 0,
		-command=> [sub {
			      my ($grp,$d,$filelistref)=@_;
			      my $fl = $grp->{filelistCurrentFilelist};
			      if ($fl and
				    $fl->name ne 'Default'
				      and userQuery($d,
						    "Realy delete filelist '".$fl->name."'?\n",
						    -bitmap=> 'question',
						    -title => "Delete filelist?",
						    -buttons => ['Delete','Cancel']) eq 'Delete'
				     ) {
				deleteFilelist($grp,$grp->{filelistCurrentFilelist});
				$fl = $grp->{filelistCurrentFilelist};
				$$filelistref=($fl && $fl->name || '');
			      }
			    },$grp,$d,\$filelist ])
    ->pack(@b_pack);

  $botframe->ImgButton(-text=> 'Save',
		-image=> icon($grp,"filesave"),
		-balloon => $grp->{Balloon},
		-balloonmsg=> "Save current file-list to a file.",
		@pad,
		-underline=> 0,
		-command=> [sub {
			    my ($grp,$d)=@_;
			    my $file=$grp->{filelistCurrentFilelist}->filename;
			    unless (defined ($file)  and $file ne EMPTY) {
			      my $initdir=dirname($file);
			      $initdir=cwd if ($initdir eq './');
			      $initdir=~s!${TrEd::Convert::Ds}$!!m;
			      $file= get_save_filename($d,-filetypes=> 
								 [["Filelists",           ['.fl']],
								  ["All files",           ['*','*.*']]
								 ],
								 -title=> "Save filelist as ...",
								 -initialdir=> $initdir,
								 -initialfile=> filename($file));
			      $d->deiconify;
			      $d->focus;
			      $d->raise;
			      $file.=".fl" unless $file=~/\.fl$/;
			      return unless (defined $file and $file ne EMPTY);
			      $grp->{filelistCurrentFilelist}->filename($file);
			    }
			    $grp->{filelistCurrentFilelist}->save;
			  },$grp,$d ])
    ->pack(@b_pack);

  $botframe->ImgButton(-text=> 'New',
		-image=> icon($grp,"filenew"),
		-balloon => $grp->{Balloon},
		-balloonmsg=> "Create a new (empty) file-list.",
		-underline=> 0,
		@pad,
		-command=> [sub {
			   my ($grp,$d,$filelistref)=@_;
			   my $fl = createNewFilelist($grp,$d);
			   $$filelistref=$fl->name if defined $fl;
			 },$grp,$d,\$filelist ])
    ->pack(@b_pack);

  $botframe->ImgButton(-text=> 'Load',
		-image => icon($grp,"fileopen"),
		-balloon => $grp->{Balloon},
		-balloonmsg=> "Load a file-list from a file.",
		@pad,
		-underline=> 0,
		-command=> [sub { $filelist=loadFilelist(@_) },$grp,$d ])
    ->pack(@b_pack);

  $botframe->Button(-text=> 'Help',
		-underline=> 0,
		-command=> [sub {
			      help_topic(shift,'filelists');
			      Tk->break;
			    },$d])->pack(qw(-padx 0.1c -pady 0.2c -side left));

  $leftframe->pack(qw/-padx 5 -side left -fill y/);
  $midframe->pack(qw/-padx 5 -side left/);
  $rightframe->pack(qw/-padx 5 -side left -expand yes -fill both/);
  $topframe->pack(qw/-padx 3 -pady 3 -side top -expand yes -fill both/);


  if ($grp->{focusedWindow}->{currentFileNo}) {
    my $path=filelistEntryPath($grp->{filelistCurrentFilelist},$grp->{focusedWindow}->{currentFileNo});
    $t->selectionClear();
    if ($path ne EMPTY) {
      eval {
	$t->anchorSet($path);
	$t->selectionSet($path);
	$t->see($path);
      };
    }
  }
  $t->focus;
  $d->BindButtons;
  $grp->{top}->Unbusy();
  if ($modal) {
    ShowDialog($d);
    $d->destroy();
    return $filelist;
  } else {
    $d->Popup;
    return $filelist;
  }

}

sub generateSortedMacroTable {
  my ($grp,$context,$flags,$order_by) = @_;
  $flags||=0;
  # 1=include-anonymous, 
  # 2=include-TredMacro,
  # 4=include-Default (not yet implemented)

  my $Keys = { %{$keyBindings{$context} ||={} } };
  my $Menus = { %{$menuBindings{$context} ||= {}} };
  if (($flags & 2) and ($context ne 'TredMacro')) {
    my $tmKeys = $keyBindings{TredMacro};
    my ($k,$v);
    while (($k,$v)=each %{ $menuBindings{TredMacro} }) {
      $Menus->{$k.' (TredMacro)'}=$v unless ($v->[1] and exists $Keys->{$v->[1]});
    }
    while (($k,$v)=each %{ $keyBindings{TredMacro} }) {
      $Keys->{$k}||=$v;
    }
  }
  my %macro_to_key = reverse %{ $Keys };
  my %macro_to_menu = map { $Menus->{$_}->[0] => $_ } keys %{ $Menus };

  my @macroTable=
    grep { defined($_->[2]) }
    map {
    my ($macro,$key) = @{ $Menus->{$_} };
    [ $_, ($Keys->{$key} eq $macro ? $key : $macro_to_key{$macro}), $macro ]
  } keys %{ $Menus };
  if ($flags|1) {
    push @macroTable,
      grep { defined($_->[2]) }
      map {
	my $macro = $Keys->{$_};
	exists($macro_to_menu{ $macro }) ? () : [ undef, $_, $macro ];
      } keys %{ $Keys };
  }
  if ($order_by eq 'K') {
    return sort {
      my @a= split '\+',$a->[1];
      my @b= split '\+',$b->[1];
      return $#a <=> $#b if ($#a != $#b);
      for my $i (0..$#a) {
	my ($ak,$bk) = ($a[$i],$b[$i]);
	return length($ak) cmp length($bk) if (length($ak) != length($bk));
	return $ak cmp $bk if ($ak ne $bk);
      }
      return $a cmp $b;
    } @macroTable;
  } elsif ($order_by eq 'P') {
    return sort { $a->[2] cmp $b->[2] } @macroTable;
  } else {
    return _u_sort(@macroTable);
  }
}

sub macrolistCreateItems {
  my ($grp,$t,$context,$include_anonymous,$see_macro,$order_by,$swap)=@_;
  my $e;
  my $style = $t->{default_style_text};
  $t->delete('all');
  $t->columnWidth(1,$see_macro ? EMPTY : 0);
  foreach my $entry (generateSortedMacroTable($grp,$context,$include_anonymous,$order_by)) {
    $e= $t->addchild(EMPTY, -data => $entry->[2]);
    my $col0 = $entry->[1];
    my $col2 = (defined($entry->[0]) ? $entry->[0] : 'ANONYMOUS');
    $col2=~s/^_+//;
    ($col0,$col2)=($col2,$col0) if $swap;
    $t->itemCreate($e, 0, -itemtype=>'text', -text=>$col0, -style=>$style);
    $t->itemCreate($e, 1, -itemtype=>'text', -text=>$entry->[2],-style=>$style) if $see_macro;
    $t->itemCreate($e, 2, -itemtype=>'text', -text=>$col2, -style=>$style);
    $t->header(configure => 0, -text=>$swap ? 'Name' : 'Key');
    $t->header(configure => 2, -text=>$swap ? 'Key'  : 'Name');
  }
}

sub createMacroList {
  my ($grp,$parent_w,$context_ref,$style_opts)=@_;
  my $t= $parent_w->Scrolled(qw/HList -columns 3
				-selectmode browse
				-header 1
				-relief sunken 
				-scrollbars ose/,
			    );
  $style_opts||={};
  my $style = $t->{default_style_text}=$t->ItemStyle(
    'text', %$style_opts
   );

  disable_scrollbar_focus($t);
  $t->BindMouseWheelVert();
  $t->header(create=>0,-itemtype=>'text',-borderwidth=>1, -relief=>'flat',-style=>$style,-text=>'Key');
  $t->header(create=>1,-itemtype=>'text',-borderwidth=>1, -relief=>'flat',-style=>$style,-text=>'Perl');
  $t->header(create=>2,-itemtype=>'text',-borderwidth=>1, -relief=>'flat',-style=>$style,-text=>'Name');
  $t->columnWidth(0,EMPTY);
  $t->columnWidth(1,0);
  $t->columnWidth(2,EMPTY);
  $t->anchorSet('0') if $t->info(exists => '0');
  $t->configure(-width=> 0);
  my $callback
    = [
       sub {
	 my ($w,$grp,$t,$ctxt)=@_;
	 my $macro = $t->info( data => $t->info('anchor') );
	 if (ref($macro) eq 'Tk::Callback') { # CODE ref gets mangled to Tk::Callback by Tk
	   $macro=$macro->[0];
	 }
	 doEvalMacro($grp->{focusedWindow},$macro);
       },$grp,$t,$context_ref,
      ];
  $t->bind('<Return>'   => $callback);
  $t->bind('<Double-1>' => $callback);
  return $t;
}

sub macrolistDialog {
  my ($grp)=@_;
  my $context=$grp->{focusedWindow}->{macroContext};
  if ($grp->{Macrolist}) {
    $grp->{Macrolist}->deiconify;
    $grp->{Macrolist}->focus;
    $grp->{Macrolist}->raise;
    return;
  }
  unless (scalar(getContexts())) {
    errorMessage($grp->{focusedWindow},"No named macros in current context ($context)",1);
    return;
  }
  my $d= $grp->{top}->Toplevel(-title=> "List of available macros");
  $d->withdraw;
  $d->resizable(0,1);
  $d->minsize('200','200');
#c  -Background white
  my $topframe = $d->Frame;
  my $t = createMacroList($grp,$topframe,\$context);
  $t->header(configure=>$_,-underline=>0) for 0..2;
  $t->configure(-height => 25);
  macrolistCreateItems($grp,$t,$context,
		       $grp->{macroListAnonymous},
		       $grp->{macroListCalls},
		       $grp->{macroListOrder},
		       0
		      );
  $grp->{Macrolist}=$d;
  my $renew_callback = [sub { #shift;
		    my ($grp,$t,$ctxt)=@_;
		    macrolistCreateItems($grp,$t,$$ctxt,
					 $grp->{macroListAnonymous},
					 $grp->{macroListCalls},
					 $grp->{macroListOrder},
					 0
					);
		  },$grp,$t,\$context];

  my $f=$topframe->Frame();
  $f->Label(-text => "Mode: ",
	    -underline => 1,
	   )->pack(qw/-side left/);
  my $om = 
    $f->Optionmenu(-options      => [getContexts()],
		   -textvariable => \$context,
		   -command      => $renew_callback,
		   -relief       => 'groove', #$menubarRelief,
		   -borderwidth  => 2);
  $om->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  $om->pack(qw/-side left -padx 5/);

  $d->bind("<Alt-o>"=>
	     [sub {
		my ($w,$but,$val)=@_;
		my $menu = $but->menu;
		my $idx = eval { $menu->index($$val) } || 0;
		$but->Post();
		$menu->activate($idx);
		Tk->break;
	      },$om,\$context]);
  $f->Button(-text=> 'Export as HTML',
	     -underline => 0,
	     -command=> [ sub {
			    my ($w,$grp,$t,$ctxt)=@_;
			    my $html = openSimpleHtml($t,$$ctxt.".html","Save list of $$ctxt macros",$ENV{HOME});
			    if ($html) {
			      print $html "<h2>TrEd Macros - $$ctxt</h2>\n";
			      print $html "<table>\n";
			      my $odd = 0;
			      foreach my $child ($t->info('children',EMPTY)) {
				print $html "  <tr ",($odd ? 'bgcolor="#ffffff"' : 'bgcolor="#eeeeee"'),
				  ">\n    <td>",$t->itemCget($child,0,'-text'),"</td>\n",
				  ($grp->{macroListCalls} ? "<td>".$t->itemCget($child,1,'-text')."</td>\n" : EMPTY),
				  "<td>", $t->itemCget($child,2,'-text'),"</td>\n",
				  "  </tr>\n";
				$odd = !$odd;
			      }
			      print $html "</table>\n";
			      closeSimpleHtml($html);
			    }
			  },$d,$grp,$t,\$context ])->pack(-padx=>'0.5c',-pady=>'0.2c',-side=>'right');

  my $rf = $f->Frame()->pack(-side=> 'right',-padx=> 20);
  $rf->Radiobutton(-anchor  => 'nw',
		   -underline => 8,
		   -text    => 'Sort by keyboard shortcut',
		   -variable=> \$grp->{macroListOrder},
		   -relief  => 'flat',
		   -command => $renew_callback,
		   -value   => 'K'
		 )->pack(-side=> 'top', -fill => 'x');
  $rf->Radiobutton(-anchor  => 'nw',
		   -underline => 8,
		   -text    => 'Sort by name',
		   -variable=> \$grp->{macroListOrder},
		   -relief  => 'flat',
		   -command => $renew_callback,
		   -value   => 'M'
		 )->pack(-side=> 'top', -fill => 'x');
  $rf->Radiobutton(-anchor  => 'nw',
		   -underline => 8,
		   -text    => 'Sort by Perl name',
		   -variable=> \$grp->{macroListOrder},
		   -relief  => 'flat',
		   -command => $renew_callback,
		   -value   => 'P'
		 )->pack(-side=> 'top', -fill => 'x');

  my $chf = $f->Frame()->pack(-side=> 'right',-padx=> 20);
  $chf->Checkbutton(-anchor  => 'nw',
		   -underline => 0,
		   -text    => 'Include anonymous macros',
		   -variable=> \$grp->{macroListAnonymous},
		   -relief  => 'flat',
		   -command => $renew_callback,
		 )->pack(-side=> 'top', -fill => 'x');

  $chf->Checkbutton(-anchor  => 'nw',
		   -underline => 5,
		   -text    => 'See Perl names',
		   -variable=> \$grp->{macroListCalls},
		   -relief  => 'flat',
		   -command => $renew_callback,
		 )->pack(-side=> 'top', -fill => 'x');

  my $botframe=$d->Frame();
  $botframe->Button(-text=> 'Run and Close',
		    -underline => 0,
	     -command=> [ sub {
			     my ($w,$grp,$t,$ctxt)=@_;
			     my $macro=$t->info(data => $t->info('anchor'));
			     $w->destroy();
			     if (ref($macro) eq 'Tk::Callback') { # CODE ref gets mangled to Tk::Callback by Tk
			       $macro=$macro->[0];
			     }
			     doEvalMacro($grp->{focusedWindow},$macro);
			   },$d,$grp,$t,\$context ])->pack(-padx=>'0.5c',-pady=>'0.2c',-side=>'left');


  $botframe->Button(-text=> 'Close',
		    -underline => 0,
		     -command=> [ sub {
				     shift->destroy();
				   },$d ])->pack(-padx=>'0.5c',-pady=>'0.2c',-side=>'right');
  $d->bind($d,'<Destroy>'=> [sub { shift; shift->{Macrolist}=undef; },$grp ]);
  $d->bind($d,'<Escape>'=> [sub {  
				 if ($_[0]->isa('Tk::Menu')) {
				   $_[0]->Leave
				 } else {
				   $_[1]->toplevel->destroy(); 
				 }
			       },$d ]);
  $d->bind($om,'<Escape>'=> sub { shift->Leave; });


  $f->pack(qw/-side bottom -fill x/);
  $t->pack(qw/-side top -fill both -expand 1/);


  $botframe->pack(qw/-side bottom -fill both/);
  $topframe->pack(qw/-side top -fill both -ipady 3 -ipadx 3 -expand 1/);

  $d->BindButtons;
  $t->focus;
  $d->Popup;
}


sub copyTreesDialog {
  my ($grp)=@_;
  return unless $grp->{focusedWindow}->{FSFile};
  my ($Entry, @Entry) = get_entry_type();
  my $range=$grp->{focusedWindow}->{treeNo}+1;
  my $source=$grp->{focusedWindow}->{FSFile};
  my $destination=$grp->{focusedWindow}->{FSFile};
  my $d= $grp->{top}->DialogBox(-title=> 'Copy Trees',
				-buttons=> ['OK', 'Cancel']);
  $d->BindReturn($d,1);
  $d->resizable(0,0);
  addBindTags($d,'dialog');
  $d->BindEscape();
  $d->bind('<Tab>',[sub { shift->focusNext; }]);
  $d->bind('<Shift-Tab>',[sub { shift->focusPrev; }]);
  $d->bind('<Shift-ISO_Left_Tab>',[sub { shift->focusPrev; }]);
  my $ff= $d->Frame();
  $ff->Label(-text=> 'Destination file:',
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  my @items;
  my $i=1;
  foreach my $of (@openfiles) {
    push @items,$i++.". ".$of->filename();
  }
  my $om = $ff->Optionmenu(
		  -relief => $buttonsRelief,
		  -options => \@items,
		  -variable => \$destination
		 )->pack(qw/-side left -padx 10/);
  $om->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  $ff->pack(qw/-pady 10 -padx 10 -side top -expand yes -fill x/);
  my $sf= $d->Frame();
  my $re=$sf->$Entry(@Entry,
		     -relief=> 'sunken',
		     -width=> 20,
		     -font=> $font,
		     -textvariable=> \$range);
  set_grp_history($grp, $re, 'treeRange');
  $sf->Label(-text=> 'Trees selection (range):',
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $re->pack(qw/-side left -padx 10 -fill x -expand yes/);
  $sf->Button(-image=> icon($grp,'1leftarrow'),
	      -command =>
	      [sub {
		  my ($grp,$range)=@_;
		  $$range=sentViewGetSelection($grp,$grp->{sentDialogSelection});
	       },$grp,\$range])->pack(qw/-padx 10 -side left/);
  $sf->Button(-image=> icon($grp,'contents'),
	      -command=> [sub {
			    my ($grp,$d,$range,$source)=@_;
			    my $list=[];
			    foreach (TrEd::Print::parse_print_list($source,$$range)) {
			      $list->[$_-1]=1;
			    }
			    $$range=sentViewGetSelection($grp,
							 viewSentencesDialog($grp,$d,$source,
									     $list
									    ));
			  },$grp,$d,\$range,$source])->pack(qw/-padx 10 -side left/);
  $sf->pack(qw/-pady 10 -padx 10 -side bottom -expand yes -fill x/);

  $d->BindButtons;
  my $result= ShowDialog($d,$re,$grp->{top});
  get_grp_history($grp, $re, 'treeRange') if ($result=~ /OK/);
  $d->destroy();
  undef $d;
  if ($result=~ /OK/) {
    $destination=~/^(\d+)/;
    my $fs=$openfiles[$1-1];
    return unless ref($fs);
    my @list=TrEd::Print::parse_print_list($source,$range);
    my $tree;
    my $any;
    foreach my $l (@list) {
      $tree=$source->tree($l-1);
      if ($tree) {
	$fs->insert_tree($fs->FS->clone_subtree($tree),
			 $fs->lastTreeNo+1);
	$any=1;
      }
    }
    if ($any) {
      $fs->notSaved(1);
      get_nodes_fsfile($grp,$fs);
      redraw_fsfile($grp,$fs);
    }
  }
}

sub initTTFonts {
  my ($grp,$toplevel)=@_;
  print STDERR "Collecting TTF fonts..." if $tredDebug;
  my $opts={};
  $grp->{ttfonts}=[];
  if ($toplevel and eval { require Tk::ProgressBar; }) {
    my $d= $toplevel->DialogBox(-title => 'Looking for TrueType fonts...',
				-buttons => ['Cancel']
			       );
    my $percent_done=0;
    my $format = '%3d/%3d  %3d%%';
    my $f1 = $d->Frame()->pack(-side=>'top', -padx => 5, -fill => 'x', -expand=> 1);
    $f1->Label(-text => "Looking for TrueType fonts. This may take a moment...\n")->pack(-side => 'left');
    my $f = $d->Frame()->pack(-side=>'top', -padx => 5, -fill => 'x', -expand=> 1);
    $f->ProgressBar(-width => 20, -length => 300, -blocks => 1, 
		    -colors => [0, 'darkblue'],
		    -troughcolor => 'white',
		    -variable => \$percent_done)->pack(-side=>'left');
    my $cancel = 0;
    $d->bind('<Escape>',sub{ $cancel=1 });
    $d->Subwidget('B_Cancel')->configure( -command => sub { $cancel=1 } );
    my $label=sprintf($format,0,0,0);
    $f->Label(-textvariable => \$label,-width=>12)->pack(-side=>'right');
    #$grp->{top}->Unbusy();
    $d->BindButtons;
    $d->Popup;
    $d->update();
    $opts = { callback => sub {
		my ($font,$i,$max)=@_;
		die "Interrupted\n" if $cancel;
		return unless $i%10==0 or $i==$max;
		$d->update;
		$percent_done = int(100* $i / $max);
		$label=sprintf($format,$i,$max,$percent_done);
	      },
	      _dlg => $d,
	      try_fontconfig => ($Tk::platform eq 'unix' ? 1 : 0),
	    };
  }
  eval {
    $grp->{ttfonts}=TrEd::Print::get_ttf_fonts($opts,
					       map TrEd::Config::tilde_expand($_),
					       split /,/,$printOptions->{ttFontPath});
  };
  if ($opts) {
    $opts->{_dlg}->destroy();
  }
  return $grp->{ttfonts};
}

sub warnWin32PrintConvert {
  my ($win)=@_;
  return 'Continue' if $^O ne 'MSWin32' or
    (which('convert.exe') ne EMPTY) or $NoConvertWarning;
  userQuery($win,
"This feature requires ImageMagick (http://www.imagemagick.org), which ".
"does not seem to be installed because 'convert.exe' was found in your PATH. ".
"Press 'Continue' if you want to try anyway.\n\n".
"To get rid of this message permanently, add NoConvertWarning=1 to your configuration file.",
	    -title => "Warning",
	    -buttons => ["Continue","Cancel"]);
}

sub warn55PrintConvert {
  my ($win)=@_;
  return 'Continue' if $NoConvertWarning;
  my $version = `$imageMagickConvert -help`;
  ($version) = split /\n/,$version;
  return 'Continue' unless ($version =~ /ImageMagick 5\.5\./);
  userQuery($win,
	    "Your version of ImageMagick ($version) is known to hang when converting from EPS. ".
            "We suggest that you upgrade ImageMagick to version >= 6.0 or downgrade to <= 5.4.7. ".
            "If you are sure you want to continue ".
	    "taking the risk that TrEd will stop responding, press Continue.\n".
	    "It is strongly recommended that you Cancel the operation now.\n\n".
	    "To get rid this message permanently, add NoConvertWarning=1 to your configuration file.",
	    -title => "Warning",
	    -buttons => ["Cancel","Continue anyway"]);
}


sub updatePrintDialogState {
  my ($grp,$w, $s, $extension,$toplevel)=@_; # widgets, state

  my %t=map { $_ => 1} keys %$w; # toggle
  my @disable;
  if ($s->{printTo} eq 'printer') {
    @disable = qw(printOnePerFile printImageMagickResolution psFile format_PDF format_SVG);
  } elsif ($s->{printTo} eq 'file') {
    @disable = qw(printImageMagickResolution command);
  } elsif ($s->{printTo} eq 'convert') {
    @disable = qw(command psMedia prtFmtWidth prtFmtHeight);
  }
  if ($s->{psMedia} ne 'User') {
    push @disable, qw(prtFmtWidth prtFmtHeight);
  }

  if ($s->{printFormat} eq 'EPS') {
    push @disable,qw(font psMedia prtFmtWidth prtFmtHeight);
    push @disable,qw(printRange) unless $s->{printOnePerFile};
  } elsif ($s->{printFormat} eq 'PS') {
    push @disable,qw(font);
  } elsif ($s->{printFormat} eq 'SVG') {
    push @disable,qw(printTo_printer font);
    # push @disable,qw(printRange) unless $s->{printOnePerFile};
  } elsif ($s->{printFormat} eq 'PDF') {
    push @disable,qw(printTo_printer);
    unless ($grp->{ttfonts}) {
      $w->{font}->toplevel->Busy(-recurse => 1);
      initTTFonts($grp,$toplevel);
      foreach (sort {$a cmp $b} keys %{$grp->{ttfonts}}) {
#	$w->{font}->insert('end',$_);
	$w->{font}->addItem($_);
      }
      $w->{font}->toplevel->afterIdle(sub{
					if (exists($grp->{ttfonts}->{$s->{initTTFont}})) {
					  $s->{ttFont} = $s->{initTTFont};
					} else {
					  $s->{ttFont} = EMPTY;
					}
				      });
      $w->{font}->toplevel->Unbusy();
      $w->{font}->focus;
      eval { $w->{font}->see(0) };
    }
  }
  $t{$_}=0 for (@disable);
  if ($extension eq '?') {
    $extension = lc($s->{printFormat});
  }
  $s->{psFile}=~s/\.[^.]*$/.$extension/ if defined($extension) and
    not($s->{printTo} eq 'convert' and $extension =~ /^(?:svg|pdf|e?ps)$/);

  if ($s->{printOnePerFile}) {
    $s->{psFile}=~s/\.([^.]*)$/_\%n.$1/ if $s->{psFile}!~/[%]\d*n/;
  }

  if ($s->{psMedia} eq 'BBox') {
    $s->{prtFmtWidth} = EMPTY;
    $s->{prtFmtHeight} = EMPTY;
  } elsif ($s->{psMedia} eq 'User') {
    $s->{prtFmtWidth} = $s->{defaultPrtFmtWidth};
    $s->{prtFmtHeight} = $s->{defaultPrtFmtHeight};
  } else {
    $s->{prtFmtWidth} = $TrEd::Print::media{$s->{psMedia}}[0];
    $s->{prtFmtHeight} = $TrEd::Print::media{$s->{psMedia}}[1];
  }
  foreach my $widget (keys %t) {
    if ($t{$widget}) {
      #print "On: $widget: $w->{$widget}\n";
      eval { $w->{$widget}->configure(-state => 'normal') };
      eval { $w->{$widget}->configure(($w->{$widget}->isa('Tk::Entry') or
				       $w->{$widget}->isa('Tk::BrowseEntry') or
				       $w->{$widget}->isa('JComboBox_0_02')
				      ) ?
				      (-background => $s->{defaultBg}) : ()
				     ) };
    } else {
      #print "Off: $widget: $w->{$widget}\n";
      eval { $w->{$widget}->configure(-state=> 'disabled') };
      eval { $w->{$widget}->configure(($w->{$widget}->isa('Tk::Entry') or
				       $w->{$widget}->isa('Tk::BrowseEntry') or
				       $w->{$widget}->isa('JComboBox_0_02')
				      ) ?
				      (-background => $s->{disabledBg}) : ()
				     ) };
    }
    #print "---\n";
  }
}

# make sure that editable JComboBox only contains valid values
# Note: always get the values with GetSelected
sub _fix_combo_box_return {
  my $cw = shift;
  for my $w ($cw,
	     $cw->Subwidget('ED_Entry'),
	     $cw->Subwidget('RO_Entry'),
	     $cw->Subwidget('Popup')) {
    $w->bind($w,'<Return>',
	     [sub{
		shift;
		my $cw = shift;
		if ($cw->popupIsVisible) {
		  $cw->hidePopup;
		} else {
		  $cw->showPopup;
		};
		Tk->break;
	      },$cw]);
  }
}
sub _fix_combo_box {
  my $cw = shift;
  $cw->setSelected( $cw->GetSelected );
  for my $w ($cw,
	     $cw->Subwidget('ED_Entry'),
	     $cw->Subwidget('RO_Entry'),
	     $cw->Subwidget('Popup')) {
    $w->bind('<FocusIn>',[sub {
			    shift;
			    my $cw = shift;
			    my $lb = $cw->Subwidget('Listbox');
			    if (not defined($cw->{index_on_focus})) {
			      $cw->{index_on_focus} = $cw->CurSelection;
			      $cw->see($cw->{index_on_focus})
				if $cw->{index_on_focus} ne q{};
			    }
			  },$cw]);
    $w->bind('<FocusOut>',[sub {
			     shift;
			     my $cw = shift;
			     $cw->EntryEnter;
			     $cw->{index_on_focus} = undef;
			   },$cw]);

    $w->bind($w,'<Return>',
	     [sub{
		shift;
		my $cw = shift;
		if ($cw->popupIsVisible) {
		  $cw->hidePopup;
		  $cw->EntryEnter;
		} else {
		  $cw->EntryEnter;
		  $cw->showPopup;
		};
		Tk->break;
	      },$cw]);
  }
}

sub printDialog {
  my ($grp)=@_;
  my $win = $grp->{focusedWindow};
  return unless $win->{FSFile};
  my ($Entry,@Entry) = get_entry_type();
  my $e_hist=[];

  my (%w,%s); # widgets, state
  $s{command}=$printOptions->{defaultPrintCommand};

  $s{psFile}=$printOptions->{psFile};
  $s{psFile} =doEvalHook($win,"print_tree_filename_hook",$win->{FSFile}->appData('tred.print.filename'));
  $s{psFile}=$win->{FSFile}->appData('tred.print.filename') if $s{psFile} eq EMPTY;
  $s{psFile}=$win->{FSFile}->filename if $s{psFile} eq EMPTY;
  $s{psFile}=~s/\.[^.]*$/.$printOptions->{printFileExtension}/;

  $s{printRange}=$win->{treeNo}+1;# unless $printRange ne EMPTY;
  $s{defaultPrtFmtWidth}=$printOptions->{prtFmtWidth};
  $s{defaultPrtFmtHeight}=$printOptions->{prtFmtHeight};

  $s{printImageMagickResolution}=$printOptions->{printImageMagickResolution};

  for my $opt (qw(printTo printFormat printSentenceInfo printFileInfo printNoRotate printOnePerFile
		  printColors prtFmtWidth prtFmtHeight prtHMargin prtVMargin psMedia)) {
    $s{$opt}=$printOptions->{$opt};
  }
  $s{initTTFont} = $printOptions->{ttFont};
  if ($s{printFormat} eq 'PDF' and defined $s{initTTFont}) {
    initTTFonts($grp,$grp->{top}) unless $grp->{ttfonts};
    if ($grp->{ttfonts} and exists($grp->{ttfonts}->{$s{initTTFont}})) {
      $s{ttFont} = $s{initTTFont};
    }
  } else {
    $s{ttFont} = EMPTY;
  }

  # Dialog
  my $d= $grp->{top}->DialogBox(-title=> "Print",
				-buttons=> ["OK", "Help", "Save configuration", "Cancel"]);
  $d->resizable(0,0);
  addBindTags($d,'dialog');
  $d->BindEscape();
  $d->Subwidget('B_Save configuration')->configure(-command =>
						    [\&savePrintConfig,$win,\%s,\%w,1]);

  $d->BindReturn($d,1);
  $d->bind('<Tab>',[sub { shift->focusNext; }]);
  $d->bind('<Shift-ISO_Left_Tab>',[sub { shift->focusPrev; }]);
  $d->bind('<Shift-Tab>',[sub { shift->focusPrev; }]);

  # Command Entry
  my $cf= $d->Frame()->pack(qw/-pady 10 -padx 10 -side top -expand yes -fill x/);
  $w{command_label}= $cf->Label(-text=> 'Print command:',
				-anchor=> 'w',
				-justify=> 'right')->pack(-side=> 'left');
  $w{command}= $cf->$Entry(@Entry,
			   -relief=> 'sunken',
			   -width=> 20,
			   -font=> $font,
			   -textvariable=> \$s{command})
    ->pack(qw/-padx 10 -side left -expand yes -fill x/);
  set_grp_history($grp, $w{command}, 'defaultPrintCommand', $e_hist);
  $s{defaultBg}=$w{command}->cget('-background');
  $s{disabledBg}=$d->cget('-background');

  # Page format selection
  my $mf = $d->Frame()->pack(qw/-pady 10 -padx 10 -side top -expand yes -fill x/);
  $mf->Label(-text=> 'Media:',
	     -underline => 0,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');

  $w{prtFmtWidth} = $mf->$Entry(@Entry,
				-textvariable => \$s{prtFmtWidth},
				-width => 5,
				-validate => 'key',
				-validatecommand => sub { shift =~ /^\s*\d*\s*$/ });
  set_grp_history($grp, $w{prtFmtWidth}, 'printFmtWidth',$e_hist);
  $w{prtFmtHeight} = $mf->$Entry(@Entry,
				 -textvariable => \$s{prtFmtHeight},
				 -width => 5,
				 -validate => 'key',
				 -validatecommand => sub { shift =~ /^\s*\d*\s*$/ });
  set_grp_history($grp, $w{prtFmtWidth}, 'printFmtHeight',$e_hist);

  my @jcombo_opts = (
    -relief => 'flat',
    -takefocus => 1,
    -borderwidth => 0,
    -highlightcolor => 'black',
    -highlightbackground => 'gray',
    -highlightthickness => 1,
    -background => 'gray',
    -popupbackground => 'black',
    -borderwidth => 1,
    -buttonrelief => 'ridge'
   );


  # TrueType font
  my $of=$d->Frame();
  my $bf=$of->Frame();

  my %fmtbut;
  my $pbf = $bf->Frame();
  $w{font_label}=$pbf->Label(-text=> 'Font (TTF):',
			       -anchor=> 'sw',
			       -justify=> 'right');

  $w{font}=$pbf->JComboBox_0_02(
    -width => 30,
    -mode => 'editable',
    -validate => 'match',
    -textvariable => \$s{ttFont},
    -choices => [$grp->{ttfonts} ? (sort {$a cmp $b} keys %{$grp->{ttfonts}}) : ()],
    @jcombo_opts
   );
  _fix_combo_box($w{font});

  # Page media
  $w{psMedia}=$mf->JComboBox_0_02(
    -mode => 'editable',
    -validate => 'match',
    -listhighlight => 1,
    -textvariable => \$s{psMedia}, # global variable in TrEd::Config
    -choices => ['BBox', 'User', 
		 sort {$a cmp $b} grep !/\d+x\d+|^ISO/, 
		 keys %TrEd::Print::media ],
    -selectcommand => [
      sub {
	updatePrintDialogState(@_[0..4]);
	1;
      },$grp,\%w,\%s,undef,$d
     ],
    @jcombo_opts,
   )->pack(-side=> 'left');
  _fix_combo_box($w{psMedia});
  $d->bind('<Alt-m>',[sub{shift;shift->{psMedia}->focus},\%w]);

  $w{prtFmtWidth}->raise($w{psMedia});
  $w{prtFmtHeight}->raise($w{psMedia});
  $mf->Label(-text=> 'Width:',
	     -padx => 10,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $w{prtFmtHeight}->pack(-side=> 'left');
  $mf->Label(-text=> 'Height:',
	     -padx => 10,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $w{prtFmtWidth}->pack(-side=> 'left');

  # Page Margins
  $mf->Label(-text=> 'X margin:',
	     -underline => 0,
	     -padx => 10,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $w{prtHMargin} = $mf->$Entry(@Entry,
			       -textvariable => \$s{prtHMargin},
			       -width => 5,
			       -validate => 'key',
			       -validatecommand => 
			       sub { shift =~ /^\s*\d*[cimp]?\s*$/ })->pack(-side=> 'left');
  $d->bind('<Alt-x>',[sub{shift;shift->{prtHMargin}->focus},\%w]);

  set_grp_history($grp, $w{prtHMargin}, 'printHMargin',$e_hist);
  $mf->Label(-text=> 'Y margin:',
	     -underline => 0,
	     -padx => 10,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $w{prtVMargin}=$mf->$Entry(@Entry,
			     -textvariable => \$s{prtVMargin},
			     -width => 5,
			     -validate => 'key',
			     -validatecommand => 
			     sub { shift =~ /^\s*\d*[cimp]?\s*$/ })->pack(-side=> 'left');
  $d->bind('<Alt-y>',[sub{shift;shift->{prtVMargin}->focus},\%w]);
  set_grp_history($grp, $w{prtVMargin}, 'printVMargin',$e_hist);


  # Output filename
  my $ff=$d->Frame();
  $w{file_label}= $ff->Label(-text=> 'File name:',
			     -anchor=> 'w',
			     -justify=> 'right')->pack(-side=> 'left');
  $w{psFile}= $ff->$Entry(@Entry,
			-relief=> 'sunken',
			-width=> 50,
			-font=> $font,
			-textvariable=> \$s{psFile})
    ->pack(qw/-padx 10 -side left -expand yes -fill x/);
  $d->bind('<Alt-r>',[sub{shift;shift->{psFile}->focus},\%w]);
  set_grp_history($grp, $w{psFile}, 'printFile',$e_hist);
  if ($s{psFile} ne EMPTY) {
    my $start = rindex($s{psFile},"/")+1;
    my $end = rindex($s{psFile},".");
    if ($start<$end) {
      $w{psFile}->selectionClear();
      $w{psFile}->selectionRange($start,$end);
      $w{psFile}->icursor($start);
    }
  }

  # Print range
  my $sf= $d->Frame();
  $w{printRange}=$sf->$Entry(@Entry,
			     -relief=> 'sunken',
			     -width=> 20,
			     -font=> $font,
			     -textvariable=> \$s{printRange});
  set_grp_history($grp, $w{printRange}, 'printRange',$e_hist);
  $w{findFile} = $ff->Button(-text => '...',
			     -underline => 0,
		      -command =>
		      [sub {
			 my ($d,$s)=@_;
			 my $initdir=dirname($s->{psFile});
			 $initdir=cwd() if ($initdir eq './');
			 $initdir=~s!${TrEd::Convert::Ds}$!!m;
			 my $file=
			   get_save_filename($d,-title => "Print To File ...",
					     $^O eq 'MSWin32' ? () :
					     (-initialfile=> filename($s->{psFile})),
					     -d $initdir ? (-initialdir=> $initdir) : (),
					     -filetypes=>
					     [
					      ($s->{printFormat} eq 'PDF' ?
					      ["PDF files", [qw/.pdf .PDF/]] :
					      ($s->{printFormat} eq 'SVG' ?
					      ["SVG files", [qw/.svg .SVG/]] :
					      ["PostScript files", [qw/.ps .eps .PS .EPS/]])),
					      ["All files", '*']
					     ]
					    );
			 $s->{psFile}=$file if (defined $file and $file ne EMPTY);
		       },$d,\%s])->pack(qw/-padx 10 -side left/);

  # Bitmap Resolutions
  my $imf=$bf->Frame();
  $w{printImageMagickResolution}=$imf->JComboBox_0_02(
    -mode => 'editable',
    -validate => 'key',
    -validatecommand => sub { $_[0]=~/^\d*$/ },
    -choices => ['50','60', '75','80','90','100','120','135','150','160','180',
		 '200','225','240','260','300','360','600','720'],
    -textvariable => \$s{printImageMagickResolution},
   );
  _fix_combo_box_return($w{printImageMagickResolution});
  my %printbuttons = ( printer => [$bf,'Send to printer',undef,8],
		       file =>[$bf,'Print to file','?',9],
		       convert =>[$imf,'Convert to a bitmap format by extension (ImageMagick)','png',13]
		     );

  # print To buttons
  foreach (qw(printer file convert)) {
    $w{"printTo_$_"} = $printbuttons{$_}[0]->
      Radiobutton(-text    => $printbuttons{$_}[1],
		  -value   => $_,
		  -underline => $printbuttons{$_}[3],
		  -variable=> \$s{printTo},
		  -relief  => 'flat',
		  -command =>
		  [\&updatePrintDialogState,$grp,\%w,\%s,$printbuttons{$_}[2],$d]
		 );
  }
  $w{printTo_convert}->pack(qw/-anchor w -side left -fill y -expand 1/);

  $imf->Label(-text => "Resolution", -underline => 7)->pack(qw/-padx 10 -side left/);
  $imf->pack(qw/-fill x -expand yes -anchor nw/);
  $w{printImageMagickResolution}->pack(qw/-padx 10 -side left/);

  $d->bind('<Alt-i>',[sub{shift;shift->{printImageMagickResolution}->focus},\%w]);

  $w{printTo_convert}->lower($w{printImageMagickResolution});

  foreach (qw(printer file)) {
    $w{"printTo_$_"}->pack(qw/-fill y -anchor nw/);
  }


  $bf->Frame()->pack(qw/-pady 5/);

  # output format buttons
  my %fmtbuttons = ( PS => [$bf,'Create PostScript','ps',11],
		     EPS =>[$bf,'Create EPS','eps',7],
		     SVG =>[$bf,'Create SVG','svg',7],
		     PDF =>[$pbf,'Create PDF','pdf',8],
		   );
  foreach (qw(PS EPS SVG PDF)) {
    $w{"format_$_"} = $fmtbuttons{$_}[0]->
      Radiobutton(-text    => $fmtbuttons{$_}[1],
		  -value   => $_,
		  -underline => $fmtbuttons{$_}[3],
		  -variable=> \$s{printFormat},
		  -relief  => 'flat',
		  -command =>
		  [\&updatePrintDialogState,$grp,\%w,\%s,$fmtbuttons{$_}[2],$d]
		 );
  }
  foreach (qw(PS EPS SVG)) {
    $w{"format_$_"}->pack(qw/-fill y -anchor nw/);
  }
  $w{format_PDF}->pack(qw/-anchor w -side left -fill y -expand 1/);
  $w{font_label}->pack(qw/-padx 10 -side left/);
  $w{font}->pack(qw/-padx 10 -side left/);
  $pbf->raise($w{format_EPS});
  $pbf->pack(qw/-fill x -expand yes -anchor nw/);

  $bf->Frame()->pack(qw/-pady 5/);

  # print options
  $w{printColors}=$bf->Checkbutton(-text=> 'Use colors',
				   -underline => 0,
			       -variable=> \$s{printColors},
			       -relief  => 'flat')->pack(-fill=> 'y',-anchor=> 'nw');
  $w{printFileInfo}=$bf->Checkbutton(-text=> 'Print filename and tree number',
				     -underline => 8,
				     -variable=> \$s{printFileInfo},
				     -relief  => 'flat')->pack(-fill=> 'y',-anchor=> 'nw');
  $w{printSentenceInfo}=$bf->Checkbutton(-text=> 'Print sentence',
				     -underline => 8,
				 -variable=> \$s{printSentenceInfo},
				 -relief  => 'flat')->pack(-fill=> 'y',-anchor=> 'nw');

  $w{printOnePerFile}=$bf->Checkbutton(-text=> 'one tree per file (use %n in the filename to place the tree number)',
				       -underline => 4,
				       -variable=> \$s{printOnePerFile},
				       -command => [\&updatePrintDialogState,$grp,\%w,\%s,undef,$d],
				       -relief  => 'flat')->pack(-fill=> 'y',-anchor=> 'nw');

  $w{printNoRotate}=
    $bf->Checkbutton(-text    => 'Disable landscape rotation of wide trees',
		     -underline => 30,
		     -variable=> \$s{printNoRotate},
		     -relief  => 'flat')->pack(-fill=> 'y',-anchor=> 'nw');
  $bf->pack(-side=> 'left');

  $of->pack(qw/-padx 10 -pady 10 -side top -expand yes -fill x/);
  $sf->Label(-text=> 'Page range:',
	     -underline => 5,
	     -anchor=> 'w',
	     -justify=> 'right')->pack(-side=> 'left');
  $d->bind('<Alt-r>',[sub{shift;shift->{printRange}->focus},\%w]);
  $w{printRange}->pack(qw/-side left -padx 10 -fill x -expand yes/);

  for ($sf,$ff) {
    $_->raise($of);
  }

  # fill range buttons
  $sf->Button(-image=> icon($grp,'1leftarrow'),
	      -command =>
	      [sub {
		 my ($grp,$w)=@_;
		 my $rng = sentViewGetSelection($grp,$grp->{sentDialogSelection});
		 $w->{printRange}->delete(0,'end');
		 $w->{printRange}->insert(0,$rng);
	       },$grp,\%w])->pack(qw/-padx 10 -side left/);
  $sf->Button(-image=> icon($grp,'contents'),
	      -command=> [sub {
			    my ($grp,$win,$d,$w)=@_;
			    my $list=[];
			    foreach (TrEd::Print::parse_print_list(
					  $win->{FSFile},
					   $w->{printRange})) {
			      $list->[$_-1]=1;
			    }
			    my $rng = sentViewGetSelection($grp,
							   viewSentencesDialog($grp,$d,
									       $win->{FSFile},
									       $list));
			    $w->{printRange}->delete(0,'end');
			    $w->{printRange}->insert(0,$rng);
			  },$grp,$win,$d,\%w ])->pack(qw/-padx 10 -side left/);

  $sf->pack(qw/-pady 10 -padx 10 -side bottom -expand yes -fill x/);
  $ff->pack(qw/-pady 10 -padx 10 -side bottom -expand yes -fill x/);

  updatePrintDialogState($grp,\%w,\%s, $printOptions->{printFileExtension},$d);
#  $toFile ? $fe->focus : $ce->focus;

  $d->BindButtons;
  my $result= ShowDialog($d,$s{printTo} eq "command" ? $w{command} : $w{psFile},$grp->{top});
  savePrintConfig($win,\%s,\%w,0);

  my $one_per_file = 1 if $s{printOnePerFile};
  get_grp_histories($grp,$e_hist) if ($result =~ /OK/);
  $d->destroy;
  undef $d;

  if ($result=~ /OK/) {
    return () if $s{printTo} eq 'convert' and
                 warnWin32PrintConvert($win) eq 'Cancel';
    return () if $s{printTo} eq 'convert' and
                 warn55PrintConvert($win) eq 'Cancel';
    return {
      -onePerFile => $one_per_file,
      -range => $s{printRange},
      -to => (
	($s{printTo} eq 'file') ? 'file' :
	($s{printTo} eq 'convert') ? 'convert'
	: 'pipe'),
      -format => $s{printFormat},
      -filename => TrEd::Config::tilde_expand($s{psFile}),
      -sentenceInfo => $s{printSentenceInfo} ? sub { get_value_line($win,$_[0],$_[1],1,0,'print') } : undef,
      -fileInfo => $s{printFileInfo},
      -imageMagickResolution => $s{printImageMagickResolution},
      -convert => $imageMagickConvert,
      -command => $s{command},
      -colors => $s{printColors},
      -noRotate => $s{printNoRotate},
     };
  
  } else {
    return ();
  }
}

sub savePrintConfig {
  my ($win,$s,$widgets,$save_to_tredrc)=@_;
  my $grp = $win->{framegroup};
  for my $opt (qw( printRange printOnePerFile printTo printFormat psFile
		   printSentenceInfo printFileInfo printImageMagickResolution
		   printNoRotate printColors ttFont prtHMargin prtVMargin )) {
    $printOptions->{$opt}=$s->{$opt};
  }
  $printOptions->{defaultPrintCommand}=$s->{command};
  $printOptions->{psMedia}=$widgets->{psMedia}->GetSelected;
  ($printOptions->{printFileExtension})=$s->{psFile}=~m!\.([^.\\/]+)$!;

  $win->{FSFile}->changeAppData('tred.print.filename',$s->{psFile});
  if ($save_to_tredrc) {
    saveRuntimeConfig($grp,{
      ';' => 'Options saved from the Print dialog',
      %$printOptions
     });
  }
}

sub printThis {
  my ($grp)=@_;
  my $win = $grp->{focusedWindow};
  return unless $win->{FSFile};

## uncomment to get preview (see also below)
#  my $dlg = $grp->{top}->DialogBox(-title=> 'Print Preview',
#				   -buttons=> ['Close']);
#  my $canvas=$dlg->Scrolled('Canvas');

  my $canvas=$grp->{top}->Canvas();
  my ($one_per_file,$range,$print_opts);
  my $err;
  do {{
    $err = 0;
    $print_opts = printDialog($grp) || return;
    my $one_per_file = delete $print_opts->{-onePerFile};
    if ($print_opts->{-format} eq 'PDF' and (!$grp->{ttfonts} or !$grp->{ttfonts}->{$printOptions->{ttFont}})) {
      plainErrorMessage($win,"You must select TrueType font for PDF!");
      $err = 1;
    }
    if ($one_per_file and ($print_opts->{-filename}!~/[%]\d*n/) and ($print_opts->{-range}=~/[\-,]/)) {
      plainErrorMessage($win,"Use %n in the output filename if you need one tree per file!");
      $err = 1;
    }
  }} while ($err);
  my $range = delete $print_opts->{-range};
  $range = $win->{treeNo}+1 unless (defined($range) and length($range));

  my $stylesheet = $win->{stylesheet};
  my $ss = undef;
  if ($stylesheet ne STYLESHEET_FROM_FILE()) {
    $ss=$grp->{stylesheets}->{$stylesheet};
  }
  my $fsfile = $win->{FSFile};
  my @range = ($one_per_file ? TrEd::Print::parse_print_list($fsfile,$range) : ($range));
  my $max_num_length = $one_per_file ? max(map length, @range) : 0;
  my %std_options =
    map {
      $TrEd::Config::defaultPrintConfig{$_}[0] => $printOptions->{$_}
    } qw(psFontFile psFontAFMFile psFontSize prtFmtWidth prtFmtHeight
	 prtHMargin prtVMargin maximizePrintSize psMedia);

  eval {
  for my $r (@range) {
    my $filename = $print_opts->{-filename};
    my $command = $print_opts->{-command};
    if ($one_per_file) {

      $filename =~ s/[%](\d*)n/sprintf("%".($1 ne EMPTY ? '0'.int($1) : '0'.$max_num_length)."d",$r)/e;
      $command =~ s/[%](\d*)n/sprintf("%".($1 ne EMPTY ? '0'.int($1) : '0'.$max_num_length)."d",$r)/e;
    }
    TrEd::Print::Print({
      %std_options,
      %$print_opts,
      -filename => $filename,
      -command => $command,
      -fsfile => $fsfile,
      -toplevel => $grp->{top},
      -canvas => $canvas,
      -range => $r,
      -hidden =>$win->{treeView}->get_showHidden(),
      -ttFont =>  ($grp->{ttfonts} ? $grp->{ttfonts}->{$printOptions->{ttFont}} : EMPTY),
      -treeViewOpts => $treeViewOpts,
      -styleSheetObject=>$ss,
      -context => $win,
      -onGetNodes => \&printGetNodesCallback,
      -onGetRootStyle => \&onGetRootStyle,
      -onGetNodeStyle => \&onGetNodeStyle,
      -onRedrawDone => \&onRedrawDone,
    });
  } };
  errorMessage($win, $@) if $@;
  get_nodes_win($win); # printGetNodesCallback have fiddled with $win
## uncomment to get preview (see also above)
#  $canvas->pack();
#  ShowDialog($dlg);

  $canvas->destroy();
}

sub getWindowPatterns {
  my ($win)=@_;
  if ($win->treeView->patterns()) {
    return @{$win->treeView->patterns()}
  } elsif ($win->{FSFile}) {
    return $win->{FSFile}->patterns();
  } else {
    return ();
  }
}

sub getWindowHint {
  my ($win)=@_;
  if (defined($win->treeView->hint)) {
    return ${$win->treeView->hint()};
  } elsif ($win->{FSFile}) {
    return $win->{FSFile}->hint();
  } else {
    return undef;
  }
}

sub getWindowContextRE {
  my ($win)=@_;
  my $grp = cast_to_grp($win);
  my $stylesheet = $win->{stylesheet};
  if (exists($grp->{stylesheets}->{$stylesheet})) {
    return $grp->{stylesheets}->{$stylesheet}->{context};
  } else {
    return undef;
  }
}


sub switchStylesheet {
  my ($grp_or_win,$stylesheet)=@_;
  my ($grp,$win) = grp_win($grp_or_win);
  return unless ref($win);
  my $prevstylesheet=$win->{stylesheet};
  return if $prevstylesheet eq $stylesheet and 
    $stylesheet ne STYLESHEET_FROM_FILE(); # the file might have changed
  if ($stylesheet eq NEW_STYLESHEET()) {
    $stylesheet=QueryString($grp,"Stylesheet name", "Name: ");
    if (!defined($stylesheet)) {
      $stylesheet=$prevstylesheet;
    } elsif (grep /^\Q$stylesheet\E$/i, keys %{$grp->{stylesheets}}) {
      errorMessage($win,
		   "Stylesheet named '$stylesheet' already exists!\n",1);
      $stylesheet=$prevstylesheet;
    } else {
      my ($hint,$context,$patterns) = getStylesheetPatterns($win);
      $grp->{stylesheets}->{$stylesheet}->{hint}=$hint;
      $grp->{stylesheets}->{$stylesheet}->{context}=$context;
      $grp->{stylesheets}->{$stylesheet}->{patterns}=$patterns;
      updateStylesheetMenu($grp);
      saveStyleSheetFile($grp,$defaultStylesheetPath,$stylesheet);
    }
    applyWindowStylesheet($win,$stylesheet);
    $grp->{selectedStylesheet} = $stylesheet if isFocused($win);
  } elsif ($stylesheet eq DELETE_STYLESHEET()) {
    if ($prevstylesheet eq STYLESHEET_FROM_FILE()) {
      $grp->{selectedStylesheet} = $prevstylesheet if isFocused($win);
      return 0;
    }
    $stylesheet=$prevstylesheet;
    my $answer=userQuery($win,
			 "Really delete stylesheet '$stylesheet'?",
			 -bitmap=> 'question',
			 -title => "Delete stylesheet?",
			 -buttons => ['Yes', 'No']);
    if ($answer eq 'Yes') {
      deleteStylesheet($grp,$stylesheet);
    } else {
      $grp->{selectedStylesheet} = $stylesheet if isFocused($win);
      return 0;
    }
  } else {
    return 0 if (doEvalHook($win,"pre_switch_stylesheet_hook",
			    $prevstylesheet,$stylesheet) eq 'stop');
    applyWindowStylesheet($win,$stylesheet);
    doEvalHook($win,"switch_stylesheet_hook",$prevstylesheet,$stylesheet);
    if ($win->{FSFile}) {
      get_nodes_win($win);
      redraw_win($win);
    }
  }
  return 1;
}

sub switchContext {
  my ($win,$context,$noredraw)=@_;
  my $grp = cast_to_grp($win);
  my $prevcontext=$win->{macroContext};
  $win->{macroContext}=$context;
  my $ret = doEvalHook($win,"allow_switch_context_hook",$prevcontext,$context);
  if ($ret eq 'stop') {
    $win->{macroContext}=$prevcontext;
    $grp->{selectedContext}=$prevcontext     if (isFocused($win));
    return 0;
  }
  $win->{macroContext}=$prevcontext;
  return 0 if (doEvalHook($win,"pre_switch_context_hook",$prevcontext,$context,$win) eq 'stop');
  $win->{macroContext}=$context;
  if (isFocused($win)) {
    $grp->{selectedContext}=$context;
    updateStylesheetMenu($grp);
    update_macrolist_view($win);
    updateCurrentContextMenu($grp);
  }
  my ($l1,$l2)=($win->{got_nodes}, $win->{redrawn});
  doEvalHook($win,"switch_context_hook",$prevcontext,$context);
  unless ($noredraw) {
    get_nodes_win($win) unless $l1 < $win->{got_nodes};
    redraw_win($win) unless $l2 < $win->{redrawn};		# something should be done with display attrs vs windows maybe
  }
}

sub onGetNodeStyle {
  my ($treeview,$node,$styles,$win)=@_;
  doEvalHook($win,"node_style_hook",$node,$styles);
}
sub onGetRootStyle {
  my ($treeview,$node,$styles,$opts,$win)=@_;
  doEvalHook($win,"root_style_hook",$node,$styles,$opts);
}
sub onRedrawDone {
  my ($treeview,$win)=@_;
  doEvalHook($win,"after_redraw_hook",$treeview);
}
sub onGetNodes {
  my ($treeview,$fsfile,$tree_no,$current,$win)=@_;
  $win->{got_nodes}++;
  doEvalHook($win,"get_nodelist_hook",
	     $fsfile,
	     $tree_no,
	     $current,
	     $treeview->get_showHidden());
}

sub printGetNodesCallback { # called from print_trees
  my ($win,$treeview,$fsfile,$tree_no,$current)=@_;
  local $TrEd::TreeView::on_get_nodes = [\&onGetNodes,$win];
  $win->{treeNo}=$tree_no;
  $win->{root}=$fsfile->treeList->[$tree_no];
  return (($win->{Nodes},$win->{currentNode}) = $treeview->nodes($fsfile,
								 $tree_no,
								 $current));
}

sub onTreeChange {
  my ($win)=@_;
  return if $insideEval; # we don't want to redraw if called from a macro
  # not only because it is really expensive, but also because
  # calling this many times (say 1K) results in so many afterIdle calls
  # on various places (such as configure(-status=>'disabled') on value line)
  # that TrEd seems stuck when returning from a macro
  my $grp = $win->{framegroup};
  get_nodes_fsfile_tree($grp,$win->{FSFile},$win->{treeNo},1);
  update_value_line($grp);
  redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
  my $tv = $win->treeView;
  $tv->reset_scroll_region;
#  my $node = $win->{currentNode};
#  $tv->canvas->see(-item =>
#		     $tv->get_node_pinfo($node,"Oval"));

  centerTo($win,$win->{currentNode});
  $grp->{top}->idletasks;
}

sub onNodeChange {
  my ($win,$change,$node)=@_;
  if ($change =~ m/^newNode/ and fileSchema($win->{FSFile})) {
    unless (determineNodeType($win,$node)) {
      pruneNode($win,$node);
      return;
    }
  }
  get_nodes_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
  redraw_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
}

sub update_value_line_current {
  my ($win,$node)=@_;
  return if $win->{noRedraw};
  my $grp=$win->{framegroup};
  my $vl=$grp->{valueLine};
  if ($win == $grp->{focusedWindow}) {
    eval {
      $vl->tagRemove('current','0.0','end');
      $vl->tagRemove('sel','0.0','end');
      my $tag = doEvalHook($win,"highlight_value_line_tag_hook",$node);
      $tag = "$node" unless defined $tag;
      my ($first,$last)=('0.0','0.0');
      while (($first,$last)=$vl->tagNextrange("$tag",$last)) {
 	$vl->tagAdd('current',
		    $first,$last);
# 		    $tag.".first",
# 		    $tag.".last",
#	   );
 	$vl->see('current.first');
      }
    };
  }
}

sub onCurrentChange {
  my ($win,$node,$prev)=@_;
  my $n;
  my $tv=$win->treeView;
  update_value_line_current($win,$node);
  foreach $n ($node,$prev) {
    $tv->canvas->itemconfigure($tv->get_node_pinfo($n,"Oval"),
			       nodeOptions($win,$n)
			      );
    if ($tv->get_node_pinfo($n,"NodeHasBox")) {
      $tv->canvas->itemconfigure($tv->get_node_pinfo($n,"TextBox"),
				 nodeBoxOptions($win,$n,0));
    }
    if ($tv->get_node_pinfo($n,"EdgeHasBox")) {
      $tv->canvas->itemconfigure($tv->get_node_pinfo($n,"EdgeTextBox"),
				 nodeBoxOptions($win,$n,1));
    }
    my $item = $tv->get_node_pinfo($n,"Oval");
    $tv->canvas->coords($item, $tv->node_coords($n,$win->{currentNode}));
    $tv->apply_stored_style_opts("Oval",$n);
    $tv->apply_stored_style_opts("TextBox",$n);
    $tv->apply_stored_style_opts("EdgeTextBox",$n);
  }
  $tv->apply_stored_style_opts("CurrentOval",$node);
  $tv->apply_stored_style_opts("CurrentTextBox",$node);
  $tv->apply_stored_style_opts("CurrentEdgeTextBox",$node);

  unless ($prev eq $node) {
    eval {
      my $stripe = $tv->get_node_pinfo($node,"Stripe");
      if (defined($stripe)) {
	$tv->canvas->itemconfigure($stripe, -fill => $tv->get_stripeColor);
	$tv->canvas->itemconfigure("textbg_$node", -fill => undef ) if $tv->get_verticalTree;
      }
    };
    eval {
      my $stripe = $tv->get_node_pinfo($prev,"Stripe");
      if (defined($stripe)) {
	my $col = $tv->realcanvas->cget('-background');
	$tv->canvas->itemconfigure($stripe, -fill =>  $col);
	$tv->canvas->itemconfigure("textbg_$prev", -fill => $col )
	  if $tv->get_verticalTree;
      }
    };
    doEvalHook($win,"current_node_change_hook",$node,$prev) unless $insideEval;
    update_status_info($win);
  }
}

sub prepareFont {
  my ($grp,$spec,$name)=@_;
  my $mw = $grp->{top};
  my $fonts = $grp->{fonts}||={};

  return $spec if $spec=~/^\s*-/; # X11Font
  my @spec;
  if ($spec!~/^\s*\{/) {
    my @a=split(/\s*,\s*/,$spec);
    my ($option,$value);
    foreach (@a) {
      ($option, $value)= split(/\s*:\s*/, $_, 2);
      push @spec, "-".$option, $value if ($option=~/^(?:size|weight|family|slant|underline|overstrike)$/);
    }
  } else {
    @spec=$mw->fontActual($spec);
  }

  if ($fonts->{$name}) {
    $fonts->{$name}->configure(@spec);
  } else {
    eval { $mw->fontDelete($name) };
    $fonts->{$name} = $mw->fontCreate($name,@spec);
  }
  return $name;
}


sub prepareFonts {
  my ($grp)=@_;
  print STDERR "Preparing fonts.\n" if $tredDebug;

  my %c_font_defaults=(
    small       => 'family:sans,size:7',
    small_bold  => 'family:sans,weight:bold,size:7',
    heading     => 'family:sans,weight:bold,size:11',
    fixed       => 'family:courier,size:9',
    default     => 'family:sans,size:9',
    bold        => 'family:sans,size:9,weight:bold',
    italic      => 'family:sans,size:9,slant:italic',
   );
  my $mw = $grp->{top};
  if ($guiFont) {
    $guiFont = prepareFont($grp,$guiFont,'C_gui');
    eval { $mw->optionAdd("*font",$guiFont); };
  }
  $treeViewOpts->{font} = $font = prepareFont($grp,$font,'C_normal');
  $vLineFont = prepareFont($grp,$vLineFont,'C_vline');
  for my $name (qw(small small_bold heading fixed default bold italic)) {
    my $fnt = $c_fonts{$name} || $c_font_defaults{$name};
    prepareFont($grp,$fnt,'C_'.$name);
  }
}


sub addBindTags {
  my $w=shift @_;
  $w->bindtags([@_,$w,ref($w),$w,$w->toplevel,'all']);
}

sub cascadeMenus {
  $maxMenuLines=max2($maxMenuLines,3);
  my $uM=[ @_[0..min($maxMenuLines-1,$#_)] ];
  my $uuM=$uM;
  my $i=$maxMenuLines;
  while ($i<=$#_) {
    my $m = [@_[$i..min($i+$maxMenuLines-1,$#_)]];
    push @$uuM,[Cascade=> 'More...', -menuitems=> $m];
    $uuM=$m;
    $i+=$maxMenuLines;
  }
  return $uM;
}

sub saveFileStateUpdate {
  my ($win)=@_;
  my $grp = $win->{framegroup};
  return if $grp->{noSaveFileStateUpdate};
  return unless isFocused($win);
  return unless $win->{framegroup}->{saveButton};
  $win->{framegroup}->{saveButton}->
    configure(-state => (($win->{FSFile} and $win->{FSFile}->notSaved) ? 'normal' : 'disabled'));
}


sub About {
  my ($grp)=@_;
  my $message=EMPTY;
  my $contextinfo=EMPTY;
  my $fileinfo=EMPTY;
  my $colinf=EMPTY;
  if ($grp->{focusedWindow}->{FSFile}) {
    $fileinfo=
      "Current file:\n".
	$grp->{focusedWindow}->{FSFile}->filename."\n".
	  "Format: ".$grp->{focusedWindow}->{FSFile}->fileFormat.", ".$grp->{focusedWindow}->{FSFile}->lastTreeNo." trees\n";
    $contextinfo="Current context: ".$grp->{focusedWindow}->{macroContext}."\n";
    my %colinf=(Shadow=> [], Hilite=> [], XHilite=> []);
    my $some_color;
    foreach ($grp->{focusedWindow}->{FSFile}->FS->attributes) {
      my $color = $grp->{focusedWindow}->{FSFile}->FS->color($_);
      unless ($color eq 'normal') {
	push @{$colinf{$color}},$_ ;
	$some_color=1;
      }
    }
    if ($some_color) {
      $colinf="Coloured attributes:".
	"\n    Highlited: ".join(",",@{$colinf{Hilite}}).
	"\n    XHighlited: ".join(",",@{$colinf{XHilite}}).
	"\n    Shadow: ".join(",",@{$colinf{Shadow}})."\n";
    }
  }

  doEvalHook($grp->{focusedWindow},"about_file_hook",\$message);
  my $ver=$VERSION;
  $grp->{top}->toplevel->
    messageBox(-icon=> 'info',
	       -type=> 'ok',
	       -message=>
		 "This is Tree Editor TrEd\nVersion $ver\nRunning Tk $Tk::VERSION\n\n".
	       "\n\n$fileinfo$contextinfo$colinf$message\n".ABOUT."\n",
	       -title=> 'About');
}

sub newTrEdWindow {
  my ($grp)=@_;

  my $win= TrEd::Window->new(newTreeView($grp),framegroup=>$grp);
  $win->{macroContext}= $opt_t && exists($keyBindings{$opt_t}) 
    ? $opt_t : 'TredMacro';
  $win->{stylesheet} = STYLESHEET_FROM_FILE();
  my $windows = $grp->{treeWindows};
  my $focused_win = $grp->{focusedWindow};
  if ($focused_win) {
    @$windows = map { ( $_ == $focused_win) ? ($_,$win) : $_ } @$windows;
  } else {
    push @$windows, $win;
  }
  $grp->{rmsplitButton}->configure(-state => @$windows>1 ? 'normal' : 'disabled')
    if $grp->{rmsplitButton};
  return $win;
}

sub newTreeView {
  my ($grp)=@_;

  my $canvas=
    $grp->{top}->Scrolled('Canvas',
		   -width=> $defCWidth,
		   -height=> $defCHeight,
		   qw /-relief sunken
		       -borderwidth 2
                       -scrollbars se/,
		   -scrollregion=> [qw/0 0 0 0/],
		   $treeViewOpts->{backgroundColor} 
		   ? (-background=> $treeViewOpts->{backgroundColor}) : ()
		  );
  canvasBindMouseWheelVert($canvas,"");
  canvasBindMouseWheelHoriz($canvas,"Shift");
  canvasBindMouseScale($grp,$canvas,"Control");
  createCanvasBindings($grp,$canvas);
  addBindTags($canvas,'my');
  addBindTags($canvas->Subwidget('scrolled'),'canvas');

  my $balloon=$grp->{top}->Balloon(-initwait=> $canvasBalloonInitWait,
				  -state=> 'balloon',
				 );
  $balloon->Subwidget('message')->configure(-foreground=> $canvasBalloonForeground);

  $balloon->Tk::Toplevel::configure(-background=> $canvasBalloonBackground);
  $balloon->Subwidget('message')->configure(-justify=> 'left',-font=> $font);
  my $treeView=new TrEd::TreeView($canvas,'CanvasBalloon'=> $balloon);
  $treeView->apply_options($treeViewOpts);
  return $treeView;
}

sub NavigateMenuByFirstKey {
  my $w = shift;
  my $char = shift;
  return unless (defined $char);
  $char = lc($char);
  my $last = $w->index('last');
  my $active = $w->index('active');
  return if ($last eq 'none');
  $active = 0 if $active eq 'none';
  for my $i ( $active+1..$last, 0..$active ) {
    print STDERR "navigate menu\n" if $tredDebug;
    my $label = eval {local $SIG{__DIE__};  $w->entrycget($i,'-label') };
    next unless defined($label);
    $label = lc($label);
    if ((substr($label,0,1) eq $char) or
	  $label =~ /^[^[:alnum:]]\Q$char\E/) {
      $w->activate($i);
      return;
    }
  }
}

sub findCanvasWindow {
  my ($grp,$canvas)=@_;
  foreach my $w (@{$grp->{treeWindows}}) {
    return $w if $w->contains($canvas);
  }
  return undef;
}

sub focusNextWindow {
  my ($grp)=@_;
  my $windows=$grp->{treeWindows};
  my $idx = Index($windows,$grp->{focusedWindow});
  return focusCanvas($windows->[($idx+1) % @$windows]->canvas,$grp);
}
sub focusPrevWindow {
  my ($grp)=@_;
  my $windows=$grp->{treeWindows};
  my $idx = Index($windows,$grp->{focusedWindow});
  return focusCanvas($windows->[$idx-1]->canvas,$grp);
}

sub clearCanvasFocus {
  my ($grp)=@_;
  if ($grp->{focusedWindow}) {
    $grp->{focusedWindow}->canvas()->configure(@normal_win_opts);
    $grp->{focusedWindow}->canvas()->itemconfigure('stipple',-state=> $stippleInactiveWindows ? 'normal' : 'hidden');
  }
}

sub focusCanvas {
  my ($c,$grp)=@_;
  if ($grp->{focusedWindow}) {
    return if $grp->{focusedWindow}->contains($c);
    clearCanvasFocus($grp);
  }
  if ($c) {
    $c->configure(@focused_win_opts);
    $c->itemconfigure('stipple',-state=> 'hidden');
  }

  my $newfocus=findCanvasWindow($grp,$c);
  if ($newfocus) {
    my $prevcontext = $grp->{selectedContext};
    my $context = $newfocus->{macroContext};
    doEvalHook($grp->{focusedWindow},"pre_switch_context_hook",$prevcontext,$context,$newfocus); # stop is ignored here
    $grp->{selectedContext}=$context;
    my $prevfl=$grp->{focusedWindow}->{currentFilelist};
    $grp->{focusedWindow}=$newfocus;
    $grp->{selectedStylesheet} = $newfocus->{stylesheet};
    $treeViewOpts->{drawBoxes}=$newfocus->{treeView}->get_drawBoxes();
    $treeViewOpts->{drawEdgeBoxes}=$newfocus->{treeView}->get_drawEdgeBoxes();
    $treeViewOpts->{showHidden}=$newfocus->{treeView}->get_showHidden();
    $treeViewOpts->{highlightAttributes}=$newfocus->{treeView}->get_highlightAttributes;
    update_value_line($grp);
    update_status_info($grp->{focusedWindow});
    update_value_line_current($newfocus,$newfocus->{currentNode});
    update_minor_modes($newfocus);
    updateTitle($grp);
    updateScaleFactor($grp);
    resetUndoStatus($newfocus);
    resetTreePosStatus($grp);
    updateSessionStatus($grp);
    update_macrolist_view($grp);
    updateCurrentContextMenu($grp);
    updateStylesheetMenu($grp);
    updateNodeMenu($grp);
    my $fl = $newfocus->{currentFilelist};
    update_sidepanel_filelist_view($grp,$fl,$fl == $prevfl ? 0 : 1);
    doEvalHook($newfocus,"switch_context_hook",$prevcontext,$context);
  } else {
    print STDERR "DID NOT FIND Window of $c\n";
  }
}

sub splitWindow {
  my ($grp,$dir,$opts)=@_;
  $opts ||= {};
  my $twin     = newTrEdWindow($grp);
  my $canvas=$twin->canvas();
  $canvas->configure($opts->{no_focus} ? @normal_win_opts : @focused_win_opts);
  my $win = $grp->{focusedWindow};
  return unless $win;
  clearCanvasFocus($grp) unless $opts->{no_focus};
  $win->split_frame($canvas,$dir,$opts->{ratio});
  unless ($opts->{no_init}) {
    foreach (qw(FSFile treeNo currentNode currentFileNo macroContext currentFilelist)) {
      $twin->{$_}=$win->{$_};
    }
    $twin->{minorModes}=[ @{$win->{minorModes}||[]} ];
  }
  applyWindowStylesheet($twin,$grp->{selectedStylesheet});
  focusCanvas($canvas,$grp) unless $opts->{no_focus};
  unless ($opts->{no_redraw}) {
    get_nodes_win($twin);
    redraw_win($twin);
  }
  return $twin;
}

sub removeWindow {
  my ($grp,$win)=@_;
  $win ||= $grp->{focusedWindow};
  my $windows = $grp->{treeWindows};
  if (@$windows > 1) {
    doEvalHook($win,"pre_switch_context_hook",$win->{macroContext},'<NONE>',$win);
    @$windows=grep {$_ ne $win} @$windows;
    $grp->{rmsplitButton}->configure(-state => 'disabled') if $grp->{rmsplitButton} and @$windows<=1;
    closeFile($win,-no_update => 1, -keep_postponed => 1);
    my $brother=$win->canvas_destroy();
    if ($win == $grp->{focusedWindow}) {
      delete $grp->{focusedWindow};
      focusCanvas($brother,$grp);
    }
    $win->{treeView}=undef;
    undef $win;
  }
}

sub canvasBindMouseScale {
  my($grp,$w,$modifier)= @_;
  $modifier.="-" if ($modifier);
  my $sub = sub {
    my ($c,$grp,$amount)=@_;
    $amount/=600; # Tk::Ev('D') gives at least 120 on Win32
    my $win;
    if ($c->isa('Tk::Toplevel')) {
      $win=$grp->{focusedWindow};
    } else {
      $win=findCanvasWindow($grp,$c);
    }
    my $tv=$win->treeView;
    my $scale =max2(-2,min2(2,$tv->{scale}+$amount));
    $tv->scale($scale,0);
    updateScaleFactor($grp);
    Tk->break;
  };
  for my $widget ($Tk::platform eq 'MSWin32' ?
		  ($grp->{top},$w) : ($w)) {
    $widget->Tk::bind("<${modifier}MouseWheel>", [ $sub, $grp, Tk::Ev("D")]);
  }
  if ($Tk::platform ne 'MSWin32') {
    $w->CanvasBind("<${modifier}4>", [ $sub, $grp, 60]);
    $w->CanvasBind("<${modifier}5>", [ $sub, $grp, -60]);
  }
}


sub canvasBindMouseWheelVert {
    my($w,$modifier)= @_;
    $modifier||="";
    $modifier.="-" if ($modifier);
    for my $widget ($Tk::platform eq 'MSWin32' ?
		    ($w->toplevel,$w) : ($w)) {
      $widget->Tk::bind("<$modifier"."MouseWheel>",
			[ sub {
			    $_[1]->yview('scroll',-($_[2]/120),'units')
			  }, $w, Tk::Ev("D")]);
    }
    if ($Tk::platform ne 'MSWin32') {
      $w->CanvasBind("<$modifier"."4>", sub { $_[0]->yview('scroll', -3, 'units')
						unless $Tk::strictMotif; 
					      Tk->break;
					    });
      $w->CanvasBind("<$modifier"."5>", sub { $_[0]->yview('scroll', 3, 'units')
						unless $Tk::strictMotif;
					      Tk->break;
					    });
      if ($modifier eq EMPTY) {
	$w->CanvasBind("<6>", sub { $_[0]->xview('scroll', -3, 'units')
				      unless $Tk::strictMotif; });
	$w->CanvasBind("<7>", sub { $_[0]->xview('scroll', 3, 'units')
				      unless $Tk::strictMotif; });
      }
    }
}

sub canvasBindMouseWheelHoriz {
    my($w,$modifier)= @_;
    $modifier||="";
    $modifier.="-" if ($modifier);
    for my $widget ($Tk::platform eq 'MSWin32' ?
		    ($w->toplevel,$w) : ($w)) {
      $widget->Tk::bind("<$modifier"."MouseWheel>",
			  [ sub { $_[1]->xview('scroll',-($_[2]/120),'units') }, $w, Tk::Ev("D")]);
    }
    if ($Tk::platform ne 'MSWin32') {
      $w->CanvasBind("<$modifier"."4>", sub { $_[0]->xview('scroll', -3, 'units')
						unless $Tk::strictMotif; });
      $w->CanvasBind("<$modifier"."5>", sub { $_[0]->xview('scroll', 3, 'units')
						unless $Tk::strictMotif; });
    }
}

sub keyBind {
  local $_=shift;
  s/-/+/g;
  s/Control/CTRL/g;
  return uc($_);
}

sub createCanvasBindings {
  my ($grp,$canvas) = @_;
  ## Canvas bindings 
  $canvas->CanvasBind('<ButtonPress>',[\&focusCanvas,$grp]);
  foreach my $tag (qw(text line)) {
    $canvas->bind($tag,
		  '<Any-Enter>'
		    => [sub{
			  my ($c,$grp)=@_;
			  my $win=findCanvasWindow($grp,$c);
			  my $tv=$win->treeView;
			  my ($t)=$tv->find_item('withtag','current');
			  my $node=$tv->get_obj_pinfo($t);
			  $tv->store_node_pinfo($node,"SaveColor",
						$c->itemcget($t,'-fill'));
			  $c->itemconfigure($t,-fill=> $activeTextColor);
			}, $grp]);

    $canvas->bind($tag,
		  '<Any-Leave>'
		    => [sub{
			  my ($c,$grp)=@_;
			  my $win=findCanvasWindow($grp,$c);
			  my $tv=$win->treeView;
			  my ($t)=$tv->find_item('withtag','current');
			  my $node=$tv->get_obj_pinfo($t);
			  $c->itemconfigure('current',
					    -fill=>
					      $tv->get_node_pinfo($node,"SaveColor"));
			}, $grp]);
  }
  # Button-1
  my ($dx,$dy);
  $canvas->CanvasBind('<Control-1>', [sub {
  					my ($c)=@_;
  					return if $c->find(withtag=>'current');
  					($dx,$dy) = ($c->canvasx($c->pointerx-$c->rootx),$c->canvasy($c->pointery-$c->rooty));
  					Tk->break;
  				      }]);
  $canvas->CanvasBind('<ButtonRelease-1>',sub {
			if (defined $dx) {
			  undef $dx; undef $dy;
			  Tk->break;
			}
		      });
  $canvas->CanvasBind('<B1-Motion>',
		      [sub {
			 return unless defined $dx;
			 my ($c,$grp)=@_;
			 return if $c->find(withtag=>'current');
			  my $win = findCanvasWindow($grp,$c);
			  my $tv=$win->treeView;
			  my $t = $tv->get_node_pinfo($win->{currentNode},'Oval');
			  my ($x,$y) = ($c->canvasx($c->pointerx-$c->rootx),$c->canvasy($c->pointery-$c->rooty));
			  if ($t) {
			    my @corners = ( $c->canvasx(0)-10, $c->canvasy(0)-10,
					    $c->canvasx($c->width)+10, $c->canvasy($c->height)+10 );
			    my @scrollregion=@{$c->cget('-scrollregion')};
			    $c->configure(-scrollregion =>
					    [ min($corners[0]-$x+$dx,$scrollregion[0]),
					      min($corners[1]-$y+$dy,$scrollregion[1]),
					      max($corners[2]-$x+$dx,$scrollregion[2]),
					      max($corners[3]-$y+$dy,$scrollregion[3]) ] );
			    $c->xviewCoord($dx,$c->xviewCoord($x));
			    $c->yviewCoord($dy,$c->yviewCoord($y));
			    Tk->break;
			  }
		      },$grp]);
  $canvas->bind('point', '<1>'=> [sub {node_down(@_) },$grp,0]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-Button-1>"=> [sub {node_click_modif(@_)},$grp,$_]);
  }
  $canvas->bind('point', '<ButtonRelease-1>'=> [sub {node_release(@_)},$grp,0]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-ButtonRelease-1>"=> [sub {node_release_modif(@_)},$grp,$_]);
  }
  $canvas->bind('point', '<B1-Motion>'=> [sub {node_move(@_)},$grp]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-B1-Motion>"=> [sub {node_motion_modif(@_)},$grp]);
  }

  # Button-3
  $canvas->bind('point','<3>'=> [sub {node_down(@_)},$grp,1]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-Button-3>"=> [sub {node_click_modif(@_)},$grp,"-3"]);
  }
  $canvas->bind('point', '<ButtonRelease-3>'=> [sub {node_release(@_)},$grp,3]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-ButtonRelease-3>"=> [sub {node_release_modif(@_)},$grp,"$_-3"]);
  }
  $canvas->bind('point','<B3-Motion>'=> [sub {node_move(@_)},$grp,1]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-B3-Motion>"=> [sub {node_motion_modif(@_)},$grp,"$_-3"]);
  }

  # Button-2
  $canvas->CanvasBind('<2>'=> [sub {follow_mouse_press(@_)},$grp]);
  $canvas->CanvasBind('<B2-Motion>'=> [sub {follow_mouse(@_)},$grp]);

  # Button-2
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-Button-2>"=> [sub {node_click_modif(@_)},$grp,$_,"$_-2"]);
  }
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-ButtonRelease-2>"=> [sub {node_release_modif(@_)},$grp,"$_-2"]);
  }
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-B2-Motion>"=> [sub {node_motion_modif(@_)},$grp,"$_-2"]);
  }

  # Text 1
  for my $tag (qw(plaintext text textbg textbox edgebox stripe)) {
    $canvas->bind($tag, '<1>'=> [sub {node_down(@_) },$grp,0]);
    $canvas->bind($tag, '<B1-Motion>'=> [sub {node_move(@_) },$grp,0]);
    $canvas->bind($tag, '<ButtonRelease-1>'=> [sub {node_release(@_)},$grp,0]);
    foreach (qw(Shift Control Alt Meta)) {
      $canvas->bind($tag, "<$_-B1-Motion>"=> [sub {node_motion_modif(@_)},$grp]);
      $canvas->bind($tag, "<$_-B2-Motion>"=> [sub {node_motion_modif(@_)},$grp,"$_-2"]);
      $canvas->bind($tag, "<$_-B3-Motion>"=> [sub {node_motion_modif(@_)},$grp,"$_-3"]);
      $canvas->bind($tag, "<$_-ButtonRelease-1>"=> [sub {node_release_modif(@_)},$grp,$_]);
      $canvas->bind($tag, "<$_-ButtonRelease-2>"=> [sub {node_release_modif(@_)},$grp,"$_-2"]);
      $canvas->bind($tag, "<$_-ButtonRelease-3>"=> [sub {node_release_modif(@_)},$grp,"$_-3"]);
      $canvas->bind($tag, "<$_-Button-1>"=> [sub {text_click_modif(@_)},$grp,$_]);
      $canvas->bind($tag, "<$_-Button-2>"=> [sub {text_click_modif(@_); Tk->break; },$grp,"$_-2"]);
      $canvas->bind($tag, "<$_-Button-3>"=> [sub {text_click_modif(@_); Tk->break; },$grp,"$_-3"]);
    }
  }

  # Text Dobule-1
  for my $tag (qw(text textbg)) {
    $canvas->bind($tag, '<Double-1>'=> [sub { editAttr(@_); Tk->break; },$grp]);
    for my $but (2,3) {
      $canvas->bind($tag, "<Double-$but>"=> [sub {text_doubleclick_modif(@_); Tk->break; },$grp,"$but"]);
    }
    foreach (qw(Shift Control Alt Meta)) {
      $canvas->bind($tag, "<$_-Double-1>"=> [sub {text_doubleclick_modif(@_); Tk->break; },$grp,$_]);
      for my $but (2,3) {
	$canvas->bind($tag, "<$_-Double-$but>"=> [sub {text_doubleclick_modif(@_); Tk->break; },$grp,"$_-$but"]);
      }
    }
  }

  # point Double-1
  $canvas->bind('point', "<Double-1>"=> [sub { editAttrs(@_); Tk->break; },$grp]);
  foreach (qw(Shift Control Alt Meta)) {
    $canvas->bind('point', "<$_-Double-1>"=> [sub { node_doubleclick_modif(@_); Tk->break; },$grp,$_]);
  }

  # Line clicks
  for my $modif (undef,qw(Shift Control Alt Meta)) {
    for my $clicktype (qw(Button Double)) {
      for my $button (1..3) {
	my $event = join '-',grep {defined} ($modif, $clicktype, $button);
	$canvas->bind('line', "<$event>"=> 
			[
			  sub {line_click(@_)},$grp,
			  $button,
			  $clicktype eq 'Double' ? 1 : 0,
			  $modif
			 ]);
      }
    }
  }
}

# sub MenubarItem {
#   my ($menubar) = shift;
#   my %opts = @_;
#   if ($menubar->class eq 'Menu') {
#     $menubar->cascade(%opts);
#   } else {
#     my $label = delete $opts{-label};
#     if ($label ne EMPTY) {
#       my $underline = index($label,'~')+$[;
#       if ($underline >= 0 and !exists($opts{-underline})) {
# 	$label =~ s/~//;
# 	$opts{-underline} = $underline;
#       }
#       $opts{-text} = $label;
#     }
#     $menubar->Menubutton(%opts)->pack(qw/-side left/);
#   }
# }

sub _menu_swaps {
  return (
    ['MENUBAR:NODE:UP_LEVEL'      => 'MENUBAR:NODE:LEFT_SIBLING'],
    ['MENUBAR:NODE:DOWN_LEVEL'    => 'MENUBAR:NODE:RIGHT_SIBLING'],
   );
}

sub updateNodeMenu {
  my ($grp_or_win) = @_;
  my ($grp,$win) = grp_win($grp_or_win);
  my $m = $grp->{main_menu};
  return unless $m and
    (($grp->{main_menu_tree_orientation_state} ? 1 : 0) != (treeIsVertical($grp) ? 1 : 0));
  $grp->{main_menu_tree_orientation_state}=treeIsVertical($grp);
  for my $swap (_menu_swaps()) {
    my ($item1,$item2) = @$swap;
    my $accel1 = $m->get_menu_option($item1,'-accelerator');
    my $accel2 = $m->get_menu_option($item2,'-accelerator');
    $m->set_menu_options($item1, -accelerator => $accel2);
    $m->set_menu_options($item2, -accelerator => $accel1);
  }
}

sub _change_orientation {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  $win->treeView->set_displayMode($treeViewOpts->{displayMode});
  redraw_win($win);
  ensureCurrentIsDisplayed($win);
  updateNodeMenu($grp);
}

sub _load_menus {
  my ($grp)=@_;
  my $path = File::Spec->catfile($libDir,'TrEd','Menu','menubar.inc');
  my $code = do $path;
  return $code->($grp);
}

sub startMain {
  my $firstFile=shift;
  my $node;
  my $parent;
  my %tred; # gathers TrEd window global data, also referred to as $grp, the 'frame group'
            # since we thought that in the future we'll support multiple windows
            # and windows are called frames in the emacs terminlology

  my $top;
  if ($opt_W) {
    $top=Tk::MainWindow->new(-use => $opt_W);
  } else {
    $top=Tk::MainWindow->new();
  }
  Tk::MiscWorkarounds::apply_workarounds($top);
  $tred{top} = $top;

  $Treex::PML::IO::lwp_user_agent = TrEd::UserAgent->new($top, keep_alive=>1);

  if ($^O eq 'MSWin32') {
    # a workaround for focus being lost after popup menu usage on Win32

    require Tk::Menu;
    $top->bind('Tk::Menu', '<<MenuSelect>>', sub { if ($Tk::popup) { $Tk::popup->Unpost; } });

    # a workaround for dialog buttons showing only partial labels in Windows
    require Tk::DialogBox;
    {
      my $old=\&Tk::Widget::DialogBox;
      *Tk::Widget::DialogBox = sub {
	my $d = &$old;
	if ($d) {
	  for my $w ( grep $_->isa('Tk::Button'), $d->Subwidget ) {
	    $w->configure(-padx=>7, -pady=>2, -width=>0);
	  }
	}
	return $d;
      };
    }
    require Tk::Dialog;
    {
      my $old=\&Tk::Widget::Dialog;
      *Tk::Widget::Dialog = sub {
	my $d = &$old;
	if ($d) {
	  for my $w ( grep $_->isa('Tk::Button'), $d->Subwidget ) {
	    $w->configure(-padx=>7, -pady=>2, -width=>0);
	  }
	}
	return $d;
      };
    }

  }

#  eval {
#    require Tk::Stderr;
#    $top->InitStderr;
#  } unless -t \*STDOUT;
#  undef $@;
  for (qw(ROText Text TextUndo Entry LabEntry HistEntry SimpleHistEntry
	  Listbox HList CodeText)) {
    $top->optionAdd("\*$_.background","white");
    $top->optionAdd("\*$_.foreground","black");
    $top->optionAdd("\*$_.disabledBackground","lightgray");
    $top->optionAdd("\*$_.disabledForeground","gray20");
  }
  unless ($enableTearOff) {
    for (qw(Menu)) {
      $top->optionAdd("\*$_.tearOff",0);
    }
  }

  if ($^O ne 'MSWin32') {
    $top->optionAdd("\*Scrollbar.width","10");
    $top->optionAdd("\*Scrollbar.elementBorderWidth","1");
    $top->optionAdd("\*Scrollbar.borderWidth","1");
    $top->optionAdd("\*Scrollbar.troughColor","gray80");
  }
  {
    # make sure button flashes are visible
    my $bg = $top->optionGet('Button.background','Background');
    my $abg = $top->optionGet('Button.activeBackground','ActiveBackground');
    my $H='[a-z0-9]{2}';
    my $level = 7;
    if (($bg eq $abg) and $abg=~/^\#($H)($H)($H)$/ogi) {
      my ($r,$g,$b) = map hex, $1,$2,$3;
      if (!first {$_>=255-$level} ($r,$g,$b)) {
	# lighten
	$_+=$level for $r,$g,$b;
      } else {
	# darken
	$_-=$level for $r,$g,$b;
      }
      $abg = '#'.join '', map { sprintf('%02x',min(abs($_),255)) } $r,$g,$b;
      $top->optionAdd('*Button.activeBackground',$abg);
    }
  }

  if ($TrEd::Convert::support_unicode) {
    $top->useinputmethods(1);
  }
  my $preparedExtensions = prepareExtensions(\%tred);
  loadStyleSheets(\%tred);

  $tred{autoSaveCallback}=$top->repeat($autoSave*60000,
					       [\&autoSaveAll,\%tred]) if $autoSave>0;

  $tred{folderImage}= icon(\%tred,'folder');
  $tred{fileImage}  = icon(\%tred,'document');
  $tred{lastActionBookmark}= $lastAction;
  $tred{selectedContext}=  $opt_t || 'TredMacro';
  $tred{buildTGTSfromCSTS}=$opt_R;

  if (not $opt_G and defined($geometry) and length($geometry)) {
    if ($geometry=~/^(.*)x(.*)\+([0-9]+)\+([0-9]+)/) {
        $geometry
	 = "$1x$2+".min($3,$top->vrootwidth-$1).
	    "+".min($4,$top->vrootheight-$2);
    }
    $top->geometry($geometry);
  }
  if ($opt_W) {

    $geometry = "600x400";
    $top->sizefrom('program');
    $top->geometry($geometry);
  }
  prepareFonts(\%tred);
  $tred{treeWindows}=[];
  $tred{focusedWindow}=newTrEdWindow(\%tred);
  my $canvas = $tred{focusedWindow}->canvas();
  $canvas->configure(@focused_win_opts);

  print STDERR "Main window created.\n" if $tredDebug;

  if (-f $appIcon) {
    print STDERR "adding icon-image.\n" if $tredDebug;
    $top->iconimage($top->Pixmap(-file=> "$appIcon"));
    print STDERR "done.\n" if $tredDebug;
  }

#  $top->focusFollowsMouse;
  addBindTags($top,'my');

  print STDERR "Asking wm for exit-hook.\n" if $tredDebug;

  $top->
    protocol('WM_DELETE_WINDOW'=> [\&quit,\%tred]);


  print STDERR "Exit hook created.\n" if $tredDebug;

  $tred{Balloon}=$top->Balloon(-initwait=> $toolbarBalloonInitWait,
				       -balloonposition=> 'mouse',
				       -state=> 'balloon',
				      );
  $tred{Balloon}->Subwidget('message')->configure(-foreground=> $toolbarBalloonForeground);
  $tred{Balloon}->Tk::Toplevel::configure(-background=> $toolbarBalloonBackground);
  $tred{Toolbar}=$top->Frame;

  print STDERR "Creating menubar.\n" if $tredDebug;

  # make old calls work
  require Tk::Menu::Item;
  *Tk::Menu::Item::entryconfigure = sub {
    my ($menu,$name,%args) = @_;
    my $m = $menu->menu;
    $m->entryconfigure($m->index($name),%args);
  };
 


  # We need to pack in an optionmenu, so we cannot use menubar on windows
  # and cannot use Toplevel->configure(-menu) on other systems
  my $main_menu = $tred{main_menu} = TrEd::Menu->new(_load_menus(\%tred));
  my $menubar;
  if ($^O eq 'MSWin32') {
    $menubar = $tred{Menubar} = $tred{MenubarFrame} =
      $tred{main_menu}->create_menu_frame($top, 'MENUBAR', { -relief=> $menubarRelief });
  } else {
    $tred{MenubarFrame}=$top->Frame();
    $menubar = $tred{Menubar} =
      $tred{main_menu}->create_menubar($tred{MenubarFrame}, 'MENUBAR', { -relief=> $menubarRelief });
    $menubar->pack(qw/-fill x -expand 1 -side left/);
  }
  $tred{MenubarFrame}->pack(qw/-fill x/);
  $menubar->bind('Tk::Menu','<Tab>',['NextEntry',1]);
  $menubar->bind('Tk::Menu','<<LeftTab>>',['NextEntry',-1]);
  $top->Frame(qw/-relief sunken -height 2 -borderwidth 2/)->pack(qw/-fill x/);
  addBindTags($menubar,'my');
  {
    my %map = (
      FileMenu=>'MENUBAR:FILE',
      RecentFileMenu=>'MENUBAR:FILE:RECENT',
      NodeMenu => 'MENUBAR:NODE',
      NodeMenu=>'MENUBAR:NODE',
      TreeMenu=>'MENUBAR:TREE',
      ViewMenu=>'MENUBAR:VIEW',
      ToolsMenu=>'MENUBAR:MACROS',
      UserMenu=>'MENUBAR:MACROS:ALL_MODES',
      CurrentContextMacroMenu=> 'MENUBAR:MACROS:CURRENT_MODE',
      MinorModesMainMenu=> 'MENUBAR:VIEW:TOGGLE_MINOR_MODES',
      SetupMenu=> 'MENUBAR:SETUP',
      HelpMenu=> 'MENUBAR:HELP',
      SessionMenu=>'MENUBAR:FILE:FILE_LISTS',
      BookmarkMenu=>'MENUBAR:FILE:BOOKMARKS',
      PostponedFileMenu=>'MENUBAR:FILE:KEPT_IN_MEMORY',
      BookmarksFileMenu=>'MENUBAR:FILE:BOOKMARKS:GO_TO_BOOKMARK',
    );
    my ($k,$v)=@_;
    while (($k,$v) = each %map) {
      $tred{$k}=$main_menu->lookup_menu_item($v);
    }
    my $recentFileMenu = $tred{RecentFileMenu};
    my $i=0;
    foreach (@recentFiles) {
      $recentFileMenu->command(-label => "$i.  $_",
			       -underline=> 0,
			       -command=> [\&openStandaloneFile,\%tred,$_]);
      $i++;
    }
  }

  $tred{templateMatchMethod}=$defaultTemplateMatchMethod;
  $tred{macroListOrder}=$defaultMacroListOrder;

  $tred{selectedContext} =  'TredMacro' unless exists($keyBindings{ $tred{selectedContext} });

  $tred{ContextsMenu}=$tred{MenubarFrame}->Optionmenu(-options => [],
 	       -textvariable=> \$tred{selectedContext},
               -font => 'C_small',
 	       -command=> [sub { my ($grp,$context) = @_;
 				 switchContext($grp->{focusedWindow}, $context);
 			       },\%tred],
 	       -relief=> 'groove', #$menubarRelief,
 	       -borderwidth=> 2)->pack(qw/-side right -padx 5/);

  $tred{ContextsMenu}->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  $tred{ContextsMenuLabel}=$tred{MenubarFrame}->Label(-text=>'Mode:',
							-font => 'C_small',
							-underline=>1)->pack(qw/-side right/);
  $tred{Balloon}->attach($tred{ContextsMenu}, -balloonmsg=> "Annotation Mode");


  addBindTags($tred{Toolbar},'my');

  updateBookmarks(\%tred);

  $tred{vLineFrame}=$top->Frame();
  $tred{valueLine}=
    $tred{vLineFrame}->
      Scrolled(qw/ROText
		  -takefocus 0
		  -state disabled
                  -relief sunken
		  -borderwidth 1
		  -scrollbars ose/,
		  -font => $vLineFont,
		  -height => $valueLineHeight,
	      );
  _deleteMenu($tred{valueLine}->Subwidget('scrolled')->menu,'File');
  my $bf = $tred{bottomFrame}=$top->Frame;
  if ($displayStatusLine) {
#c		  -background white
    my $sl= $tred{statusLine}=
      $bf->
	ROText(qw(-takefocus 0
		  -state disabled
		  -borderwidth 1
		  -height 1
		  -width 10
		 ),
	       -relief => 'sunken',
	       -font => $vLineFont);
    _deleteMenu($sl->menu,'File');
    $sl->bind('<1>',
			    [sub {
				my ($w,$grp)=@_;
				my $Ev=$w->XEvent;
				my $win=$grp->{focusedWindow};
				doEvalHook($win,"status_line_click_hook",
					   $w->tagNames($w->index($Ev->xy)));
				Tk->break;
			      },\%tred]
			   );
    $sl->bind('<Double-1>',
			    [sub {
				my ($w,$grp)=@_;
				my $Ev=$w->XEvent;
				my $win=$grp->{focusedWindow};
				doEvalHook($win,"status_line_doubleclick_hook",
					   $w->tagNames($w->index($Ev->xy)));
				Tk->break;
			      },\%tred]
			   );
    $sl->pack(qw/-side left -fill x -expand yes/);
  }
  {
    $tred{minorModesMenu} = $bf->Menubutton(-image=>icon(\%tred,'puzzle'),-direction=>'above')->pack(-side => 'left',-expand => 'no');
    my $menu = $tred{minorModesMenu}->menu(qw/-tearoff 0/);
    $tred{minorModesMenu}->configure(-menu => $menu);
    $tred{minorModesLabelFrame} = $bf->Frame()->pack(-side => 'left',-expand => 'no',-padx=>5);
    $tred{minorModesLabels}={};
    $tred{Balloon}->attach($tred{minorModesMenu},
			    -balloonmsg=> "Enable/disable additional features\n(a.k.a. minor modes)");
  }
  {
    $tred{canvasScale}=0;
    $tred{canvasScaleLabel} = $bf->Label(-text=>'Scale: 100%')->pack(-side => 'left',-expand => 'no');
    my $slider = $tred{canvasScaleWidget} = $bf->Scale(
      -from => -2,
      -to=>2,
      -font => 'C_small',
      -length => 100,
      -sliderlength => 20,
      -width => 10,
      -showvalue => 0,
      -resolution => 0.1,
      -borderwidth => 1,
      -variable => \$tred{canvasScale},
      -command => [sub {
		     my ($grp,$step) = @_;
		     $grp->{focusedWindow}->treeView->scale($step,$grp->{focusedWindow}->{currentNode});
		     updateScaleFactor($grp);
		   },\%tred],
      -orient => 'horizontal' )->pack(-side => 'left',-expand => 'no');
    $slider->bindtags([$slider,ref($slider),$slider->toplevel,'all']);
    $slider->bind($slider,'<3>', sub{ $slider->set(0); Tk->break; } );
  }
  $tred{valueLine}->tagConfigure('current',
				  -background => $valueLineFocusBackground,
				  -foreground => $valueLineFocusForeground,
				 );
  for my $modif ('',qw(Shift Control Alt Meta)) {
    my $m=$modif ? $modif.'-' : '';
    for my $but ((map 'Double-'.$_, 1..3), 1..3) {
      $tred{valueLine}->bind(qq{<${m}${but}>},[\&valueLineClick,\%tred,$modif,$but]);
    }
  }

  $tred{vLineSeparator}=$top->Adjuster();
  eval { # supported only on some platforms/version of Tk
    $tred{valueLine}->configure(-foreground => $valueLineForeground,
                                 -background => $valueLineBackground);
  };
  $tred{valueLine}->BindMouseWheelHoriz();

  print STDERR "Creating buttons.\n" if $tredDebug;

  $tred{nextButton}=
    $tred{Toolbar}->Button(-takefocus=>0,
			  -text=> "Next",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"1rightarrow"),
			  -state=> 'disabled',
			  -borderwidth=> $buttonBorderWidth,
			  -command=>
			  [\&tieNextTree,\%tred]);
  $tred{Balloon}->attach($tred{nextButton},
			  -balloonmsg=> "see the next tree in the file");
  addBindTags($tred{nextButton},'my');

  $tred{prevButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Prev",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"1leftarrow"),
			  -state=> 'disabled',
			  -borderwidth=> $buttonBorderWidth,
			  -command=>
			  [\&tiePrevTree,\%tred]);
  $tred{Balloon}->attach($tred{prevButton},
			  -balloonmsg=> "see the previous tree the file");
  addBindTags($tred{prevButton},'my');

  $tred{openButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Open",
			  -relief=> $buttonsRelief,
			  -image=>
			  icon(\%tred,"fileopen"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=>
			  [\&fileDialog,\%tred])
      ->pack(-side=>'left');
  $tred{Balloon}->attach($tred{openButton},
		 -balloonmsg=> "open file");
  addBindTags($tred{openButton},'my');
  $tred{saveButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Save",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"filesave"),
			  -state => 'disabled',
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&saveFile,\%tred])->pack(-side=>'left');

  $tred{Balloon}->attach($tred{saveButton},
			  -balloonmsg=> "save current file");
  addBindTags($tred{saveButton},'my');

  $tred{reloadButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Reload",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"reload"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&reloadFile,\%tred])->pack(-side=>'left');

  $tred{Balloon}->attach($tred{reloadButton},
			  -balloonmsg=> "reload current file");
  addBindTags($tred{reloadButton},'my');


  ###################

  $tred{prevFileButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Prev file",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"start"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&tiePrevFile,\%tred])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{prevFileButton},
			  -balloonmsg=> "visit the previous file in the file-list");
  addBindTags($tred{prevFileButton},'my');

  $tred{nextFileButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Next file",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"finish"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&tieNextFile,\%tred])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{nextFileButton},
			  -balloonmsg=> "visit the next file in the file-list");
  addBindTags($tred{nextFileButton},'my');
  # bind action control
  for my $bind ([nextFileButton => \&nextRealFile],
		[prevFileButton => \&prevRealFile]) {
    my $button = $tred{$bind->[0]};
    my $cmd = $bind->[1];
    $button->bindtags([$button, ref($button), $button->toplevel, 'all']);
    $button->bind($button, '<Control-ButtonRelease-1>',
		  sub {
		    $button->flash();
		    $cmd->(\%tred);
		    Tk->break;
		  });
  }

  $tred{printButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Print",
			  -relief=> $buttonsRelief,
			  -image      => icon(\%tred,"fileprint"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [sub { printThis(@_) },\%tred])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{printButton},
			  -balloonmsg=> "print ...");
  addBindTags($tred{printButton},'my');


  #####################
  $tred{Toolbar}->Frame(-bd => 2, -width => 2, -relief => 'groove')
    ->pack(-side=> 'left', -padx => '3', -fill => 'y', -pady => 3);

  # Undo button

  $tred{undoButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Undo",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"undo"),
			  -state=> 'disabled',
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&undo,\%tred])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{undoButton},
			  -balloonmsg=> "undo current file");
  addBindTags($tred{undoButton},'my');

  # Redo button

  $tred{redoButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Redo",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"redo"),
			  -state=> 'disabled',
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&re_do,\%tred])->pack(-side=>'left');
    
  $tred{Balloon}->attach($tred{redoButton},
			  -balloonmsg=> "redo current file");
  addBindTags($tred{redoButton},'my');

  #####################
  $tred{Toolbar}->Frame(-bd => 2, -width => 2, -relief => 'groove')
    ->pack(-side=> 'left', -padx => '3', -fill => 'y', -pady => 3);


  $tred{findButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Find",
			  -relief=> $buttonsRelief,
			  -image      => icon(\%tred,"searchtool"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [sub {
					my ($grp,$template)=@_;
					findNodeDialog($grp,$template)
					  if ($grp->{focusedWindow}->{currentNode});
				      },\%tred,\%searchTemplate])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{findButton},
			  -balloonmsg=> "Find node ...");
  addBindTags($tred{findButton},'my');

  $tred{findNextButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Find Next",
			  -relief=> $buttonsRelief,
			  -image      => icon(\%tred,"searchtool_forward"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&doFindFirstTemplated,\%tred,1])
      ->pack(-side=>'left');
  $tred{Balloon}->attach($tred{findNextButton},
			  -balloonmsg=> "Find next ...");
  addBindTags($tred{findNextButton},'my');


  $tred{findPrevButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Find Previous",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"searchtool_backward"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&doFindPrevTemplated,\%tred,1])
      ->pack(-side=>'left');
  $tred{Balloon}->attach($tred{findPrevButton},
			  -balloonmsg=> "Find previous ...");
  addBindTags($tred{findPrevButton},'my');

  $tred{Toolbar}->Frame(-bd => 2, -width => 2, -relief => 'groove')
    ->pack(-side=> 'left', -padx => '3', -fill => 'y', -pady => 3);

  $tred{prevButton}->pack(-side=> 'left');
  $tred{nextButton}->pack(-side=> 'left');

  #####################
  $tred{Toolbar}->Frame(-bd => 2, -width => 2, -relief => 'groove')
    ->pack(-side=> 'left', -padx => '3', -fill => 'y', -pady => 3);

  $tred{vsplitButton}=
    $tred{Toolbar}->Button(-takefocus=>0, 
			  -text=> "Split View Vertically",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"view_left_right"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&splitWindow,\%tred,'vert'])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{vsplitButton},
			  -balloonmsg=> "split view vertically");

  $tred{hsplitButton}=
    $tred{Toolbar}->Button(-takefocus=>0, 
			  -text=> "Split View Horizontally",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"view_top_bottom"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&splitWindow,\%tred,'horiz'])->pack(-side=>'left');


  $tred{Balloon}->attach($tred{hsplitButton},
			  -balloonmsg=> "split view horizontally");

  $tred{rmsplitButton}=
    $tred{Toolbar}->Button(-takefocus=>0, 
			  -text=> "Remove Current View",
			  -relief=> $buttonsRelief,
			  -state => 'disabled',
			  -image=> icon(\%tred,"view_remove"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [\&removeWindow,\%tred])->pack(-side=>'left');
  $tred{Balloon}->attach($tred{rmsplitButton},
			  -balloonmsg=> "remove current view");


  $tred{tieWinddowsButton}=
    $tred{Toolbar}->Checkbutton(-takefocus=>0,
			      -text=> "Tie Displayed Windows",
			      -variable=> \$tred{tieWindows},
			       -relief=> $buttonsRelief,
			      -indicatoron => 0,
			      -image=>icon(\%tred,"lock"),
			      -borderwidth=> $buttonBorderWidth)->pack(-side=>'left');
  $tred{Balloon}->attach($tred{tieWinddowsButton},
			  -balloonmsg=> "tie all views");

  $tred{Toolbar}->Frame(-bd => 2, -width => 2, -relief => 'groove')
    ->pack(-side=> 'left', -padx => '3', -fill => 'y', -pady => 3);

  $tred{toggleUserToolbarButton}=
    $tred{Toolbar}->Menubutton(-takefocus=>0,
				-tearoff=>0,
				-text=> "Toggle User Toolbars",
				-relief=> $buttonsRelief,
				-indicatoron => 0,
				-state => 'disabled',
				-image=>icon(\%tred,"1downarrow"),
				-borderwidth=> $buttonBorderWidth)->pack(-side=>'left');
  $tred{Balloon}->attach($tred{toggleUserToolbarButton},
			  -balloonmsg=> "toggle user-defined toolbars");


  ##########################



  $tred{StylesheetMenu}=$tred{Toolbar}->
    Optionmenu(-options => [],
	       -font => 'C_small',
	       -textvariable=> \$tred{selectedStylesheet},
	       -command=> [sub { my ($grp,$stylesheet) = @_;
				 switchStylesheet($grp, $stylesheet);
			       },\%tred],
	       -relief=> 'groove', #$menubarRelief,
	       -borderwidth=> 2)->pack(qw/-side right -padx 3/);
  $tred{attrButton}=
    $tred{Toolbar}->Button(-takefocus=>0, -text=> "Edit Stylesheet",
			  -relief=> $buttonsRelief,
			  -image=> icon(\%tred,"wizard"),
			  -borderwidth=> $buttonBorderWidth,
			  -command=> [sub { editStylesheetDialog(@_) },\%tred])->pack(-side=>'right');
  $tred{Balloon}->attach($tred{attrButton},
			  -balloonmsg=> "customize display patterns\nof the selected stylesheet\n(e.g. change tree appearance, labels etc.)");
  $tred{StylesheetMenu}->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  $tred{StylesheetMenuLabel}=$tred{Toolbar}->Label(qw/-text Style:
							-font C_small
							-underline 2/)->pack(qw/-side right/);
  $tred{Balloon}->attach($tred{StylesheetMenu},
			  -balloonmsg=> "stylesheet (tree appearance)");


  print STDERR "Packing widgets.\n" if $tredDebug;

  $tred{Toolbar}->pack(-fill=> 'x', -padx=> '1', -pady=> 1);

  $tred{UserToolbarSep}=$top->Frame(qw/-relief sunken -height 2 -borderwidth 2/);
  $tred{UserToolbars}=$top->Frame();
  addBindTags($tred{UserToolbars},'my');
  my $vlsubframe=$tred{vLineFrame}->Frame();
  $tred{vLineNumLabel}=$vlsubframe->Label(-text => '-/-')->pack(qw/-side top -fill x/);
  $tred{Balloon}->attach($tred{vLineNumLabel},
			  -balloonmsg=> "position of the current tree\nin the file (current/total)");

  $tred{sentButton}=
    $vlsubframe->Button(-takefocus=>0, -text=> "Sentences",
			-relief=> $buttonsRelief,
			-image=> icon(\%tred,"contents"),
			-borderwidth=> $buttonBorderWidth,
			-command=> [\&viewSentences,\%tred])
      ->pack(qw/-side top -fill x/);
  $tred{Balloon}->attach($tred{sentButton},
			  -balloonmsg=> "View all trees as a list of 'sentences'...\nThis dialog also allows export to HTML.");

  $vlsubframe->pack(qw/-fill x -side right -padx 1 -anchor n/);
  $tred{valueLine}->pack(qw/-side left -fill both -expand yes/);
  $tred{vLineFrame}->pack(qw/-fill x -expand no/);


  $tred{vLineSeparator}->packAfter($tred{vLineFrame},-side => 'top');

  $tred{bodyPane}=$top->Panedwindow();
  $tred{bottomFrame}->pack(qw/-pady 2 -side bottom -fill x -expand no/);
  $tred{bodyPane}->pack(qw/-fill both -expand yes/);
  $tred{windowFrame}=$tred{bodyPane}->Pane();
  $tred{bodyPane}->add($tred{windowFrame});
  
  $tred{focusedWindow}->frame_widget($canvas,[],
				      [qw/-side left/])
    ->pack(qw/-expand yes -fill both/,
	   -in => $tred{windowFrame},
	   -side=>'right');


  # frame canvas here
  
#  $tred{sLineFrame}->pack(qw/-fill x -expand yes/);

  $tred{focusedWindow}->canvas->focus;

#  print STDERR "Binding canvas destroy...\n" if $tredDebug;
#   addBindTags($top,'TrEdMW');
#   $top->bind('TrEdMW','<Destroy>',
# 		      [ sub {
# 			  shift;
# 			  my $grp=shift;
# 			  $geometry=$top->geometry();
# 			  print "geometry is $geometry\n" if $tredDebug;
# 			  if ($^O eq "MSWin32" and $top->state() eq 'zoomed') {
# 			    $geometry=~s/\+[-0-9]+\+[-0-9]+/+-3+-3/;
# 			  }
# 			  print "state is ",$top->state(),"\n"  if $tredDebug;
# 			},\%tred ]);

  print STDERR "GUI prepared.\n" if $tredDebug;
  $top->update;

  # check if TrEd has been updated
  my $version_file = File::Spec->catfile($tred_d,'last_version');
  my $ver;
  if (open my $fh, '<', $version_file) {
    $ver=<$fh>;
    close $fh;
    chomp $ver;
  }
  if (open my $fh, '>', $version_file) {
    print $fh $VERSION,"\n";
    close $fh;
  } else {
    warn "Could not write version information to $version_file: $!\n";
    $ver = $VERSION; # do not bother the user in this case
  }
  if (!$skipStartupVersionCheck and ( !$ver or $ver ne $VERSION )) {
    if (userQuery($top, "TrEd was "
		    .($ver ? "upgraded" : "installed or upgraded")
		    ." recently.\n\n".
		        "Do you want to check for new extensions or updates?",
		  -title => "TrEd Upgraded",
		  -buttons => ["Manage Extensions","Later"]) =~ /Manage/) {
      manage_extensions(\%tred,0);
      $preparedExtensions = prepareExtensions(\%tred);
    }
  }

  $top->Busy(-recurse=> 1);
  eval { loadMacros(\%tred,{preparedExtensions=>$preparedExtensions}) };
  errorMessage($top,$@) if $@;
  print STDERR "Resource path: $Treex::PML::resourcePath\n" unless $opt_q;
  print "Starting in context $tred{focusedWindow}->{macroContext}\n" if $tredDebug;
  doEvalHook($tred{focusedWindow},"initialize_bindings_hook");

  update_macro_menus(\%tred);
  update_minor_modes(\%tred);
  updateStylesheetMenu(\%tred);
  updatePostponed(\%tred);
  updateHelpMenu(\%tred, {preparedExtensions=>$preparedExtensions});


  if (doEvalHook($tred{focusedWindow},"init_hook") eq 'stop') {
    $top->Unbusy;
    print STDERR "Stopped by init_hook\n";
    exit_tred();
  }
  my $stylesheet=$opt_s || STYLESHEET_FROM_FILE();
  $tred{selectedStylesheet}=$stylesheet;
  applyWindowStylesheet($tred{focusedWindow},$stylesheet);

  toggleSidePanel(\%tred);
  if ($opt_p) {
    my $dir=$opt_p>0 ? 'vert' : 'horiz';
    for (my $i=1;$i<abs($opt_p);$i++) {
      splitWindow(\%tred,$dir);
    }
    focusCanvas($tred{treeWindows}->[0]->canvas,\%tred);
  }
  $top->repeat(1000,sub {1}); # otherwise SIGINT would wait till next focus
  $SIG{PIPE}=sub {
    print STDERR "Caught signal SIGPIPE: $!\n";
  };
  $SIG{USR1}=sub {
    if ($insideEval) {
      print STDERR "Caught signal USR1: stopping current evaluation.\n";
    } else {
      print STDERR "Caught signal USR1: ignoring - not in a macro evaluation.\n";
    }
    print STDERR "Current call stack:\n",
      map { my ($pkg, $f, $line) = caller($_); "  $_: file $f line $line\n" } 1..5;
    $insideEval && die "Caught USR1: stopping current evaluation.\nSee the error output for details...\n"
  };
  $SIG{INT}=sub {
    if ($insideEval) {
      print STDERR "Caught SIGINT, stopping current evaluation\n";
      print STDERR "Current call stack:\n",
	map { my ($pkg, $f, $line) = caller($_); "  $_: file $f line $line\n" } 1..5;
      die "Caught SIGINT, stopping current evaluation.\nSee the error output for details...\n";
    } else {
      print STDERR "Caught SIGINT, closing all files without saving\n";
      closeAllFiles(\%tred);
      print STDERR "Good bye!\n";
      $top->destroy;
      exit_tred(1);
    }
  };

  if (findFilelist('Default')->count == 0 and findFilelist('CmdLine-1')) {
    print STDERR "Selecting CmdLine-1 filelist." if $tredDebug;
    selectFilelist(\%tred,'CmdLine-1');
  } else {
    print STDERR "Selecting Default filelist." if $tredDebug;
    selectFilelist(\%tred,'Default');
  }
  if ($opt_p) {
    my $dir=$opt_p>0 ? 'vert' : 'horiz';
    my @fl = $opt_l=~/,/g;
    my $fl=@fl+1;
    if ($fl>1) {
      $fl=min($opt_p,$fl);
      my $i;
      for (my $i=0;$i<$fl;$i++) {
	focusCanvas($tred{treeWindows}->[$i]->canvas,\%tred);
	selectFilelist($tred{treeWindows}->[$i],"CmdLine-".($i+1));
	gotoFile($tred{treeWindows}->[$i],0);
      }
    } else {
      for (my $i=1;$i<$opt_p;$i++) {
	focusCanvas($tred{treeWindows}->[$i]->canvas,\%tred);
	$tred{treeWindows}->[$i]->{currentFilelist} = $tred{treeWindows}->[0]->{currentFilelist};
	gotoFile($tred{treeWindows}->[$i],$i);
      }
    }
    focusCanvas($tred{treeWindows}->[0]->canvas,\%tred);
    $tred{tieWindows}=1;
  }

  $tred{appenddefault} = 1; #($tred{focusedWindow}{currentFilelist}->count()>0);

  # run start_hook
  if (doEvalHook($tred{focusedWindow},"start_hook") eq 'stop') {
    $top->Unbusy;
    print STDERR "Stopped by start_hook\n";
    exit_tred();
  }

  # Starting ------------------------------------------
  $top->Unbusy;
  $top->focus if ($^O eq 'MSWin32');
  if (defined $opt_e and length $opt_e) {
    my $macro = eval "package $tred{selectedContext}; sub{ $opt_e }";
    die $@ if $@;
    doEvalMacro($tred{focusedWindow},$macro);
  }


  print STDERR "Binding keystrokes...\n" if $tredDebug;
  $menubar->bind('<Escape>', sub { eval{shift->menu->Leave()}; Tk->break; } );
  $top->bind('my','<Menu>'=>
	       [sub {
		  my ($w,$grp)=@_;
		  my $mbar=$grp->{Menubar};
		  $mbar->focus;
		  $mbar->FindMenu('F'); # File
		  if ($^O eq 'MSWin32') {
		    foreach my $child (grep { $_->class eq 'Menubutton' }
					 $mbar->children) {
		      $child->ButtonUp()
		    }
		  }
		},\%tred]);
  foreach my $prefix ('Alt','Meta','Mod4') {
    $top->
      bind('my',"<$prefix-KeyPress>"=>
	   [sub {
	      if (defined(evalMacro(@_))) {
		Tk->break;
	      } else {
		# Actually, this should work by it self. And it realy
		# does, but not under windows :-) Well, do not laugh,
		# too early, Linux users. With menu (not menubutton)
		# this is the same there, only vice versa.
		my ($w,$grp,$mod)=@_;
		my $mbar=$grp->{Menubar};
		$mbar->FindMenu($w->XEvent->K);
		if ($^O eq 'MSWin32') {
		  foreach my $child (grep { $_->class eq 'Menubutton' }
				     $mbar->children) {
		    $child->ButtonUp() 
		  }
		}
		Tk->break;
	      }
	    }, \%tred,uc($prefix).'+']);
  }
  foreach my $prefix ('Alt','Meta','Mod4') {
    $top->
      bind('my',"<$prefix-o>"=>
	   [sub {
	      if (defined(evalMacro(@_))) {
		Tk->break;
	      } else {
		my ($w,$grp)=@_;
		my $but = $grp->{ContextsMenu};
		my $menu = $but->menu;
		my $ctxt = $grp->{selectedContext};
		Tk->break if $ctxt eq EMPTY;
		my $idx = eval { $menu->index($ctxt) } ;
		Tk->break if $idx eq 'none';
		$but->Post();
		eval { $menu->activate($idx) };
		$but->ButtonUp() if $^O eq 'MSWin32';
		Tk->break;
	      }
	    }, \%tred,uc($prefix).'+']);
  }
  foreach my $prefix ('Alt','Meta','Mod4') {
    $top->
      bind('my',"<$prefix-y>"=>
	   [sub {
	      if (defined(evalMacro(@_))) {
		Tk->break;
	      } else {
		my ($w,$grp)=@_;
		my $but = $grp->{StylesheetMenu};
		my $menu = $but->menu;
		my $stylesheet = $grp->{selectedStylesheet};
		Tk->break if $stylesheet eq EMPTY;
		my $idx = eval { $menu->index($stylesheet) };
		Tk->break if $idx eq 'none';
		$but->Post();
		eval { $menu->activate($idx) };
		$but->ButtonUp() if $^O eq 'MSWin32';
		Tk->break;
	      }
	    }, \%tred,uc($prefix).'+']);
  }

  #  $top->bind('my','<Control-x><KeyPress>'=>
  #			[sub { evalMacro(@_); Tk->break; }, \%tred, 'CTRL-X+' ]);

  $top->bind('my','<KeyPress>'=>
			[sub {
			   evalMacro(@_); Tk->break;
			 }, \%tred, EMPTY ]);

  foreach (qw(Shift Control Meta Alt Control-Shift Control-Alt
              Control-Meta Alt-Shift Meta-Shift)) {
    foreach my $event (qw(KeyPress Right Left Up Down
                          Return comma period Next Prior greater less)) {
      $top->bind('my',"<$_-$event>"=>
			    [sub { evalMacro(@_); Tk->break; },
			     \%tred, keyBind($_)."+"])
	unless ("$_-$event" eq "Alt-KeyPress" or "$_-$event" eq "Meta-KeyPress")
    }
  }

#  $top->bind('all','<Tab>',undef);

  # New Busy window bindings
  $top->Tk::bind('Busy','<Escape>',[\&_search_busy, \%tred]);
  $top->Tk::bind('Busy','<Any-KeyPress>',[\&Tk::Widget::_busy => 1]);
  $top->Tk::bind('Busy','<Any-KeyRelease>',[\&Tk::Widget::_busy => 0]);
  $top->Tk::bind('Busy','<Any-ButtonPress>',[\&Tk::Widget::_busy => 1]);
  $top->Tk::bind('Busy','<Any-ButtonRelease>',[\&Tk::Widget::_busy => 0]);
  $top->Tk::bind('Busy','<Any-Motion>',[\&Tk::Widget::_busy => 0]);
  $top->bind('Tk::Listbox','<KeyPress>',\&list_isearch);

  # setup default binding
  while (my ($key, $def) = each %default_binding) {
    $tred{ $def->[2] || 'Toolbar' }->bind('my', $key => [ \&default_binding, $key, \%tred ]);
  }

  print STDERR "done.\nStarting main loop.\n" if $tredDebug;
  print STDERR "Ready.\n" unless $opt_q;
  $SIG{USR2} = sub {
    $tred{top}->afterIdle([\&handleUSR2Signal,\%tred]);
  };

  MainLoop;
  if ($tred{top}) {
    saveRuntimeConfig(\%tred);
  }

  # Finished ------------------------------------------
  $top=undef;
  $tred{top} = undef;
  print STDERR "Done.\n" if $tredDebug;
}

# SIGUSR2 (afterIdle) signal handler:
# we use SIGUSR2 to notify TrEd about
# an incomming command (tred -C)
#
sub handleUSR2Signal {
  my ($grp)=@_;
  my $cmd_file = File::Spec->catfile($tred_d,'cmd_'.$$);
  if (-f $cmd_file) {
    if (((stat($cmd_file))[2] &022)==0) {
      open my $fh, '<', $cmd_file || return;
      my $cmd = <$fh>;
      unlink $cmd_file || warn("WARN: Failed to unlink $cmd_file\n");
      my @cmd=split("\0",$cmd);
      if (($cmd[0]||'') eq 'open' and @cmd==2) {
	openStandaloneFile($grp,$cmd[1]);
	return;
      } elsif (($cmd[0]||'') eq 'reload' and @cmd==2) {
	my ($fsfile) = grep { Treex::PML::IO::is_same_filename($_->filename, $cmd[1]) } @openfiles;
	if ($fsfile) {
	  if ($grp->{focusedWindow}->{FSFile} != $fsfile) {
	    my ($win)=fsfileDisplayingWindows($grp,$fsfile);
	    if ($win) {
	      focusCanvas($win->canvas(),$grp);
	    } else {
	      openStandaloneFile($grp,$fsfile->filename,-keep=>1);
	    }
	  }
	  reloadFile($grp);
	}
	return;
      } else {
	warn("WARN: Ignoring unknown command from $cmd_file\n");
      }
    } else {
      warn("WARN: Ignoring command from $cmd_file: dangerous file permissions!\n");
    }
  }
  #plainErrorMessage($grp,"USR2 Signal Caught");
}

sub newUserToolbar {
  my ($grp_or_win,
      $name,
      $opts
     )=@_;
  my $grp=cast_to_grp($grp_or_win);
  unless (keys %{$grp->{UserToolbarHash}}) {
    $grp->{UserToolbarSep}->pack(-after => $grp->{Toolbar},-fill=> 'x');
    $grp->{UserToolbars}->pack(-after => $grp->{UserToolbarSep},-fill=> 'x');
  }
  my $toolbar;
  if (exists $grp->{UserToolbarHash}{$name}) {
    die "User Toolbar named $name already exists!";
  } else {
    $toolbar = $grp->{UserToolbarHash}{$name}=$grp->{UserToolbars}->Frame->pack(-fill => 'x');
    $grp->{UserToolbarState}{$name}=1;
  }
  updateToolbarMenu($grp);
  return $toolbar;
}

sub updateToolbarMenu {
  my ($grp)=@_;
  my $menu = $grp->{toggleUserToolbarButton}->menu();
  $menu->delete(0,'end');
  $_->destroy for $menu->children;
  my $enabled=0;
  for my $name (sort keys %{$grp->{UserToolbarHash}}) {
    $enabled=1;
    $menu->add('checkbutton',
	       -label => $name.' toolbar',
	       -variable => \$grp->{UserToolbarState}{$name},
	       -command => [\&toggleUserToolbar,$grp,$name],
	      );
  }
  $grp->{toggleUserToolbarButton}->configure(-state => $enabled ? 'normal' : 'disabled');
}

sub toggleUserToolbar {
  my ($grp,$name)=@_;
  if ( $grp->{UserToolbarState}{$name} ) {
    showUserToolbar($grp,$name);
  } else {
    hideUserToolbar($grp,$name);
  }
}

sub hideUserToolbar {
  my ($grp,$name)=@_;
  my $tb =  getUserToolbar($grp,$name);
  if ($tb) {
    my $height = $tb->height;
    my %info = $tb->packInfo;
    my $master = $info{-in};
    $master->packPropagate(1);
    $tb->packForget;
    $master->update;
    $master->GeometryRequest($master->width,($master->reqheight-$height));
    $master->update;
    $grp->{UserToolbarState}{$name}=0;
    return $tb;
  }
  return 0;
}
sub showUserToolbar {
  my ($grp,$name)=@_;
  my $tb =  getUserToolbar($grp,$name);
  if ($tb) {
    $tb->pack(-fill=>'x');
    $grp->{UserToolbarState}{$name}=1;
    return $tb;
  }
  return 0;
}

sub userToolbarVisible {
  my ($grp,$name)=@_;
  my $tb =  getUserToolbar($grp,$name);
  if ($tb) {
    return $grp->{UserToolbarState}{$name};
    #return $tb->ismapped && $tb->manager ? 1 : 0;
  }
  return;
}

sub getUserToolbar {
  my ($grp_or_win,$name)=@_;
  my $grp=cast_to_grp($grp_or_win);
  return $grp->{UserToolbarHash}{$name};
}

sub removeUserToolbar {
  my ($grp_or_win,$name)=@_;
  my $grp=cast_to_grp($grp_or_win);
  my $tb = delete $grp->{UserToolbarHash}{$name};
  delete $grp->{UserToolbarState}{$name};
  print "remove toolbar $name => $tb\n" if $tredDebug;
  return unless $tb;
  if (keys %{$grp->{UserToolbarHash}}) {
    $tb->packForget;
  } else {
    $tb->packForget;
    $grp->{UserToolbars}->packForget;
    $grp->{UserToolbarSep}->packForget;
  }
  updateToolbarMenu($grp);
  return $tb;
}

sub makeCurrentNodeRoot {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $node = $win->{currentNode};
  my $fsfile = $win->{FSFile};
  return unless $fsfile and $node;
  return unless ($fsfile->test_tree_type($node) or
		   userQuery($win,"WARNING:\n\n".
			       "The type of the current node is not a permitted root type.\n\n".
				 "The options are:\n\n".
				   "[Proceed anyway] - ignore the type constraints (the tree will be invalid, but may be fixed later)\n".
				     "[Cancel] - cancel the operation\n",
			     -bitmap=> 'question',
			     -title => 'Incompatible node type',
			     -buttons => ['Proceed anyway','Cancel']) eq 'Proceed anyway');
  my $discard=0;
  my $root = $node->root;
  return if $root==$node;
  unless ($node->test_child_type($root)) {
    my $res = userQuery($win,"WARNING:\n\n".
			  "Normally, this operation cuts the subtree of the current node,\n".
			    "makes the current node a new root of the tree and\n".
			      "pastes the old root on the current node.\n\n".
				"However, the type constraints of the current node do not permit the current root ".
				  "as its a child.\nThe resulting tree would be invalid.\n\nThe options are:\n\n".
				    "[Paste anyway] - ignore the type constraints (the tree will be invalid, but may be fixed later)\n".
				      "[Discard root] - discards every node between the current root and the current node\n".
					"[Cancel] - cancel the operation\n",
			-bitmap=> 'question',
			-title => 'Incompatible node type',
			-buttons => ['Paste anyway','Discard root','Cancel']);
    return if $res eq 'Cancel';
    $discard=1 if $res=~/Discard/;
  }
  save_undo($win,prepare_undo($win,'Make Current Node the Root',UNDO_ACTIVE_ROOT_AND_TREE_ORDER));
  makeRoot($win, $node, $discard );
}

sub quit {
  my ($grp,$win)=grp_win(shift);
  # run user's exit_hook
  doEvalHook($win,"exit_hook");
  return if askSaveFiles($grp,1) == -1;
  saveRuntimeConfig($grp);
  $grp->{top}->destroy;
  $grp->{top}=undef;
}

sub getConfigFromFile {
  my @conf;
  if (open(my $fh,"<",$configFile)) {
    @conf=<$fh>;
    close($fh);
    return \@conf;
  } else {
    return;
  }
}

sub saveRuntimeConfig {
  my ($grp,$update) = @_;
  # Save configuration
  print STDERR "Saving some configuration options.\n" if $tredDebug;
  my $config = getConfigFromFile() || [];
  updateRuntimeConfig($grp,$config,$update);
  saveConfig($grp,$config);
}
sub updateRuntimeConfig {
  my ($grp,$conf,$update)=@_;
  $update||={};
  my $comment = ';; Options changed by TrEd on every close (DO NOT EDIT)';
  my $ommit="canvasheight|canvaswidth|recentfile[0-9]+|geometry|showsidepanel|lastaction|filelist[0-9]+";
  my $update_comment = delete $update->{';'};
  for (keys %$update) {
    $ommit.=qq(|$_);
  }
  @$conf = grep { !/^\s*(?:\Q$comment\E|(?:$ommit)\s*=)/i } @$conf;
  @$conf = grep { !/^\s*;*\s*\Q$update_comment\E/i } @$conf if defined $update_comment;
  pop @$conf while @$conf and $conf->[-1] =~ /^\s*$/;

  push @$conf, "\n",";; ".$update_comment."\n" if $update_comment;
  push @$conf, (map { qq($_\t=\t).$update->{$_}."\n" } keys %$update);

  push @$conf, "\n",$comment."\n";
  #  $geometry=~s/^[0-9]+x[0-9]+//;
  if ($grp->{lastActionBookmark}) {
    my $s = $grp->{lastActionBookmark};
    $s=~s/\\/\\\\/g;
    push @$conf,"LastAction\t=\t".$s."\n";
  }
  if ($grp->{top}) {
    eval {
      $geometry=$grp->{top}->geometry();
      print "geometry is $geometry\n" if $tredDebug;
      if ($^O eq "MSWin32" and $grp->{top}->state() eq 'zoomed') {
	$geometry=~s/\+[-0-9]+\+[-0-9]+/+-3+-3/;
      }
    };
  }
  do {
    my $s;
    push @$conf,
      "Geometry\t=\t".$geometry."\n",
      "ShowSidePanel\t=\t".$showSidePanel."\n",
      "CanvasHeight\t=\t".$defCHeight."\n",
      "CanvasWidth\t=\t".$defCWidth."\n",
	map { 
	  $s=$recentFiles[$_];
	  $s=~s/\\/\\\\/g;
	  "RecentFile$_\t=\t$s\n"
	} 0..$#recentFiles;

    my $i=0;
    foreach (@filelists) {
      next if $filelist_from_extension{$_}==1;
      my $fn = ref($_) && $_->filename;
      my $name = ref($_) && $_->name;
      next if ($name eq 'Default' or $name =~ /^CmdLine-\d+$/);
      unless (defined($fn) and length($fn)) {
	saveStdFilelist($_);
      } else {
	$_->save;
	if (!$filelist_from_extension{$_}) { # note: this equals 2 for "StdFilelist" loaded from ~/.tred.d
	  $s=$_->filename();
	  $s=~s/\\/\\\\/g;
	  push @$conf,"filelist".$i++."\t\t=\t".$s."\n";
	}
      }
    }
  };
  chomp $conf->[-1];
}

sub _do_goto_tree {
  my $win=shift;
  #update_value_line($win->{framegroup});
  my $no=$win->{treeNo};
  $win->{treeNo}=-1;  # this is to force getNodes & redraw
  gotoTree($win,$no);
  $win->{framegroup}->{IdleTask}=undef;
}

sub onIdleNextTree {
  my ($grp,$win)=grp_win(shift);
  return unless $win->{FSFile};
  $win->toplevel->afterCancel($grp->{IdleTask}) if ($grp->{IdleTask});
  my $last = $win->{FSFile}->lastTreeNo;
  if ($win->{treeNo}<$last) {
    $win->{treeNo}=max2(0,$win->{treeNo}+1);
    update_tree_pos($grp);
    #  update_value_line($grp);
    #  $grp->{valueLine}->idletasks();
    $grp->{vLineNumLabel}->idletasks();
    $grp->{IdleTask}=$win->toplevel->afterIdle([\&_do_goto_tree,$win]);
  }
  Tk->break;
}

sub onIdlePrevTree {
  my ($grp,$win)=grp_win(shift);
  return unless $win->{FSFile};
  if ($win->{treeNo}>0) {
    $win->toplevel->afterCancel($grp->{IdleTask}) if ($grp->{IdleTask});
    $win->{treeNo}--;
    update_tree_pos($grp);
    #    update_value_line($grp);
    #    $grp->{valueLine}->idletasks();
    $grp->{vLineNumLabel}->idletasks();
    $grp->{IdleTask}=$win->toplevel->afterIdle([\&_do_goto_tree,$win]);
  }
  Tk->break;
}

sub RepeatedShowDialog {
  my ($cw, $focus, $oldFocus)= @_;
  $oldFocus= $cw->focusCurrent unless $oldFocus;
  my $oldGrab= $cw->grabCurrent;
  my $grabStatus= $oldGrab->grabStatus if ($oldGrab);

  # instead of Popup
  $cw->deiconify;
  $cw->waitVisibility;

  Tk::catch {
    $cw->grab;
  };
  $focus->focusForce if ($focus);
  Tk::DialogBox::Wait($cw);
  eval {
    $oldFocus->focusForce;
  };
  $cw->withdraw;
  $cw->grabRelease;
  if ($oldGrab) {
    if ($grabStatus eq 'global') {
      $oldGrab->grabGlobal;
    } else {
      $oldGrab->grab;
    }
  }
  return $cw->{selected_button};
}

# This patches $dialog->Show which implicitly focuses the default button;
# here focus stays where it is.
# Usage: my $dlg=DialogBox(); ...; ShowDialog($dlg);
sub ShowDialog {
  my ($cw, $focus, $oldFocus)= @_;
  $oldFocus= $cw->focusCurrent unless $oldFocus;
  my $oldGrab= $cw->grabCurrent;
#  my $old_grab= $cw->grabSave;
#  my $old_focus= $cw->grabSave;
  my $grabStatus= $oldGrab->grabStatus if ($oldGrab);

#  $cw->grab;

  $cw->Popup();

  Tk::catch {
    $cw->grab;
  };
  $focus->focusForce if ($focus);
  Tk::DialogBox::Wait($cw);
  eval {
    $oldFocus->focusForce;
  };
  #&$old_grab;
  #&$old_focus;
  
  $cw->withdraw;
  $cw->grabRelease;
  if ($oldGrab) {
    if ($grabStatus eq 'global') {
      $oldGrab->grabGlobal;
    } else {
      $oldGrab->grab;
    }
  }

  return $cw->{selected_button};
}

sub newFileFromTemplate {
  my ($grp)=@_;
  my @templates;
  my $extensions = getExtensionList();
  foreach my $ext (@$extensions) {
    my ($dir) = getExtensionTemplatePaths([$ext]);
    if (defined ($dir)) {
      push @templates, map [ $ext, $_ ], grep !/~$|\.lock$/, glob(File::Spec->catfile($dir,'*'));
    }
  }
  if (!@templates) {
    userQuery($grp->{top},
	      "Sorry, the available extensions provide no templates.",
	      -title => "New from templates",
	      -buttons => ["OK"]);
    return;
  }
  my $choices = [map filename($_->[1])." ($_->[0])", @templates];
  my $ret = listQuery(
    $grp->{top},
    'Select a template',
    'browse',
    $choices,
    [$choices->[0]],
   );
  if (ref($ret) and @$ret) {
    return openStandaloneFile($grp,$templates[$ret->[0]][1],-justheader => 1);
  }
  return;
}

sub fileDialog {
  my ($grp,$header_only)= @_;
  my $file;
  my $win = $grp->{focusedWindow};
  my $dir;
  if ($win->{FSFile}) {
    $dir = dirname($win->{FSFile}->filename);
  }
  $file= get_open_filename($grp->{top},-filetypes=> \@open_types,
			   (-d $dir ? ( -initialdir => $dir ) : ())
			  );
  if (defined $file and $file ne EMPTY) {
    return openStandaloneFile($grp,$file,-justheader => $header_only);
  }
  return 0;
}

sub urlDialog {
  my ($grp,$header_only)= @_;
  if (not(defined $grp->{lastURL}) and
      defined($grp->{focusedWindow}->{FSFile})) {
    $grp->{lastURL} = $grp->{focusedWindow}->{FSFile}->filename();
  }
  $grp->{lastURL}||='file://';
  $grp->{urlHist} = [] unless ref($grp->{urlHist});
  my $opts={};
  if ( eval { require Tk::MatchEntry; 1 } ) {
    $opts = {
      -entry =>
      [
      'MatchEntry',
      -label=>undef,
      -choices=>[],
      -complete=>1,
      -wraparound => 1,
      -autopopup=>1,
      -fixedwidth => 0,
      -autoshrink => 1,
      -maxheight => 10,
      -listcmd => sub {
	my ($w)=@_;
	my $file = $w->Subwidget('entry')->get();
	my @files;
	if ($file !~ m{^\s*([[:alnum:]][[:alnum:]]+):}) {
	  @files = glob(TrEd::Config::tilde_expand($file).'*');
	} elsif ($file =~ m{^\s*file:}) {
	  $file = URI->new($file eq 'file:' ? 'file:///' : $file);
	  if ((blessed($file) and $file->isa('URI::file'))) {
	    @files = map { URI::file->new($_)->as_string } glob($file->file.'*');
	  }
	}
	$w->configure(-choices=>\@files);
	my $font = $w->cget('-font');
	$w->configure(-listwidth=>10+max(map $w->fontMeasure($font,$_),@files));
	$w->xview('end');
      }],
      -entry_config => sub {
	$_[0]->Subwidget('entry')->Subwidget('entry')->configure(
	  -background=>'white',
	  -foreground=>'black',
	);
	$_[0]->focus;
      },
     };
  } else {
    undef $@;
  }
  my $file = QueryString($grp,"Enter URL", "URL: ",$grp->{lastURL},1,$grp->{urlHist},
			 undef,$opts);
  if (defined $file and $file ne EMPTY) {
    $grp->{lastURL} = $file;
    return openStandaloneFile($grp,$file,-justheader => $header_only);
  }
  return 0;
}

sub askSaveReferences {
  # write embedded DOM documents
  my ($win,$fsfile,$result,$filename)=@_;
  $filename = $fsfile->filename unless defined $filename;
  my (@refs);
  my $schema = fileSchema($fsfile) || return 1;
  my $references = [ $schema->get_named_references ];
  return 1 unless @$references;
  my $name2id = $fsfile->metaData('refnames');
  my $id2href = $fsfile->metaData('references');
  foreach my $reference (@$references) {
    my $name = $reference->{name};
    my $refid = $name2id->{$name};
    if ($refid) {
      my $href = $id2href->{$refid};
      my $r;
      if ($href and $reference->{readas} =~ /^(dom|pml)$/ and 
	  ref($fsfile->appData('ref')) and $r=$fsfile->appData('ref')->{$refid}) {
	push @refs, [$href." [$refid, $name]",
		     $r,$refid,$name];
      }
    }
  }
  my $i=0;
  while ($i<@refs) {
    my $r = $refs[$i][1];
    if (UNIVERSAL::DOES::does($r,'Treex::PML::Instance')) {
      my $schema = $r->get_schema;
      my $references = [ $schema->get_named_references ];
      next unless @$references;
      my $name2id = $r->get_refname_hash();
      my $id2href = $r->get_references_hash();
      foreach my $reference (@$references) {
	my $name = $reference->{name};
	my $refid = $name2id->{$name};
	if ($refid) {
	  my $href = $id2href->{$refid};
	  if ($href and $reference->{readas} =~ /^(dom|pml)$/) {
	    my $r2 = $r->get_ref($refid);
	    $refid=$refs[$i][2].'/'.$refid;
	    $name=$refs[$i][3].'/'.$name;
	    push @refs, [$href." [$refid, $name]",
		     $r2,$refid,$name] if $r2;
	  }
	}
      }
    }
  } continue { $i++ }
  @refs=map $_->[0],@refs;
  # CURSOR
  return 1 unless @refs;
  my $initdir = dirname($filename);
  my $selection = [];
  my $return =
    listQuery(
      $win->toplevel,'Select resources to save','multiple',
      \@refs,$selection,
      label => {
	-text => <<'EOF'
This document contains data obtained from external resources.
Please select which of them should be updated:
EOF
       },
      list => {
	-exportselection => 0,
      },
      buttons => [{
	-text => 'Change filename...',
	-underline => 7,
	-command => [sub {
		       my ($l)=@_;
		       my ($file,$rest) = split / \[/,$l->get('active'),2;
		       my $initdir2 = dirname($file);
		       $initdir2 = File::Spec->catfile($initdir,$initdir2)
			 unless File::Spec->file_name_is_absolute($initdir2);
		       $file = get_save_filename(
			 $l->toplevel,
			 -filetypes=> $save_types{all},
			 -title=> "Save As ...",
			 -d $initdir2 ? (-initialdir=> $initdir2) : (),
			 $^O eq 'MSWin32' ? () : (-initialfile=> filename($file)));
		       if ($file ne EMPTY) {
			 my $index = $l->index('active');

			 my %selected = map {$_=>1} grep { $l->selectionIncludes($_) } (0 .. $l->size-1);
			 $l->insert($index,$file." [".$rest);
			 $l->delete('active');
			 $l->activate($index);
			 foreach (0 .. $l->size-1) {
			   if ($selected{$_}) {
			     $l->selectionSet($_);
			   } else {
			     $l->selectionClear($_);
			   }
			 }
		       }
		       Tk->break;
		     }]
       }]
     );
  if ($return) {
    %$result = map { /^(.*) \[([^,]+),/ ? ($2 => $1) : () } @$selection;
  }
  return $return;
}

sub saveFileAs {
  my ($win,$fsfile)= @_;
  my $initdir;
  $fsfile ||= $win->{FSFile};
  return unless $fsfile;
  my $file=$fsfile->filename;

  $initdir=dirname($file);
  $initdir=cwd if ($initdir eq './');
  $initdir=~s!${TrEd::Convert::Ds}$!!m;

  my $cur = $fsfile->backend || '';
  $cur=~s/Backend$//;
  $cur=qq{ ($cur)} if $cur;
  my $response=userQuery($win, "\nPlease,\nchoose one of the following output formats.\n\n".
			 "\nWARNING:\nsome formats may be incompatible with the current file.\n",
			 -title => "Save As ...",
			 -buttons => ["Use current".$cur,"FS","CSTS","TrXML","TEIXML","Storable","Cancel"]);
  return if ($response eq "Cancel");

  if ($response eq 'FS') {
    $file=~s/\.(?:csts|sgml|sgm|cst|trxml|trx|tei|xml)/.fs/i;
    $file=~s/\.(amt|am|m|a)/$1.fs/;
  } elsif ($response eq 'CSTS') {
    $file=~s/\.(?:fs|tei|trxml|trx|xml)/.csts/i;
  } elsif ($response eq 'TrXML') {
    $file=~s/\.(?:csts|sgml|sgm|cst|fs|tei)/.trxml/i;
  } elsif ($response eq 'TEIXML') {
    $file=~s/\.(?:csts|sgml|sgm|cst|fs|trxml|trx)/.xml/i;
  } elsif ($response eq 'Storable') {
    $file=~s/\.(?:csts|sgml|sgm|cst|fs|trxml|trx|tei|xml)/.pls/i;
  } 

  my $filetypes;
  if ($response =~ /^Use current/) {
    my ($backend) = grep { $backend_map{$_} eq $fsfile->backend} keys %backend_map;
    if ($backend) {
      $filetypes = $save_types{$backend};
    } else {
      $filetypes = $save_types{'all'};
    }
  } else {
    $filetypes = $save_types{lc($response)};
  }

  $file= get_save_filename($win->toplevel,-filetypes=> $filetypes,
				     -title=> "Save As ...",
				     -d $initdir ? (-initialdir=> $initdir) : (),
     				     $^O eq 'MSWin32' ? () : (-initialfile=> filename($file)));
  return doSaveFileAs($win,$fsfile,$file,
		    ($response !~ /^Use current/) ? $backend_map{lc($response)} : $fsfile->backend,
		    'ask','ask'
		   );
}

sub doSaveFileAs {
  my ($win, $fsfile, $filename, $backend, $update_refs, $update_filelist)=@_;
  my ($old_file,$old_backend,$old_format) = 
    ($fsfile->filename,$fsfile->backend,$fsfile->fileFormat);

  my $lock_change=0;
  if ($filename ne EMPTY) {
    if ($filename ne $fsfile->filename) {
      if ($lockFiles) {
	my $lock = checkLock(undef,$filename);
	if ($lock eq 'my') {
	  if (userQuery($win,
			"An existing lock on the file $filename indicates that it is probably used by another file-object within this process!",
			-bitmap=> 'question',
			-title => "Saving to a locked file?",
			-buttons => ['Steal lock and save','Cancel']) eq 'Cancel') {
	    return -1;
	  }
	} elsif ($lock ne 'none') {
	  if (userQuery($win,
			"File $filename was $lock!",
			-bitmap=> 'question',
			-title => "Saving to a locked file?",
			-buttons => ['Steal lock and save','Cancel']) eq 'Cancel') {
	    return -1;
	  }
	}
	$lock_change=1;
	$fsfile->changeFilename($filename);
	setFSLockInfo($fsfile, setLock($filename));
      } else {
	$fsfile->changeFilename($filename);
      }
    }
    if (defined $backend) {
      $fsfile->changeBackend($backend);
    }
    $fsfile->changeFileFormat(($filename=~/\.gz$/ ? "gz-compressed " : EMPTY).
				     $fsfile->backend);
    updateTitle($win->{framegroup});
    updatePostponed($win->{framegroup});
    if (saveFile($win,$filename)==1) {
      removeLock($fsfile,$old_file,1) if ($lock_change);

      if ($filename ne $old_file and 
	  ref($fsfile->appData('fs-part-of'))) {
	my @fs = @{$fsfile->appData('fs-part-of')};
	if ($update_refs eq 'all') {
	  # all
	  $update_refs = \@fs;
	} elsif (UNIVERSAL::isa($update_refs,'ARRAY')) {
	  # pre-selected FSFiles
	} elsif ($update_refs eq 'ask') {
	  $update_refs = [];
	  if (@fs) {
	    my $filenames = [map { $_->filename } @fs];
	    my $selection=[@$filenames];
	    listQuery(
	      $win->toplevel,
	      'Rename file also in...','multiple',
	      $filenames,$selection,
	      label => {
		-text => <<'EOF'
You have renamed the current file, but it is referred to by the file(s) below.
Please select files that should update their references to the current file:
EOF
	      },
	      list => {
		-exportselection => 0,
	      }
	     );
	    if (@$selection) {
	      my %selected = map { $_ => 1 } grep { $_ ne EMPTY } @$selection;
	      $update_refs = [grep { $selected{$_->filename} } @fs];
	    }
	  }
	}
	my @failed;
	foreach my $reff (@$update_refs) {
	  my $req = $reff->metaData('fs-require');
	  my $references = $reff->metaData('references');
	  my $match;
	  if (ref($req)) {
	    for (@$req) {
	      if ($_->[1] eq $old_file) {
		if (ref($references)) {
		  $references->{$_->[0]}=$filename;
		  $_->[1] = $filename;
		  $reff->notSaved(1);
		}
		$match = 1;
	      }
	    }
	  }
	  unless ($match) {
	    push @failed,$reff;
	  }
	}
	errorMessage($win,
		     "Could not find reference to the current file in the following files:\n\n".
		       join("\n",map { $_->filename } @fs),1) if @failed;
      }

      my $filelist = $win->{currentFilelist};
      if ($filelist and $filename ne $old_file) {
	if (!defined $update_filelist or $update_filelist eq 'ask') {
	  my $response = 
	    userQuery($win,
		      "Do you want to update the current file list (".$filelist->name.")?\n\n".
			"This will find all occurences in the file list of:\n${old_file}\n".
			  "and update them to point to:\n${filename}",
		      -bitmap=> 'question',
		      -title => 'Update file list?',
		      -buttons => ['Yes (all references)','Only current position','No']);
	  if ($response ne 'No') {
	    renameFileInFilelist($filelist, $old_file, $filename, 
				 $response =~ /^Only/ ? currentFileNo($win) : undef);
	  }
	} elsif ($update_filelist=~/^all$|^current$/) {
	  renameFileInFilelist($filelist, $old_file, $filename, 
			       ($update_filelist eq 'current') ? 
				currentFileNo($win) : undef);
	}
      }
      return 1;
    } else {
      removeLock($fsfile,$filename,1) if ($lock_change);
      $fsfile->changeFilename($old_file);
      setFSLockInfo($fsfile, setLock($old_file)) if $lock_change;
      $fsfile->changeBackend($old_backend);
      $fsfile->changeFileFormat($old_format);
      updateTitle($win->{framegroup});
      return 0;
    }
  }
  return 0;
}


sub renameFileInFilelist {
  my ($filelist, $old_file, $filename, $position)=@_;
  # TRY UPDATING THE CURRENT FILELIST:
  #  if position is undefined - update all
  #  if defined, update only given position
  return unless ref($filelist) and UNIVERSAL::can($filelist,'list_ref') and UNIVERSAL::can($filelist,'files_ref');
  my $pattern_list = $filelist->list_ref;
  my $rel_name = File::Spec->abs2rel($filename, $filelist->filename);
  # my %fixed;
  for my $i (defined ($position) ? $position : 0..($filelist->file_count()-1)) {
    my $fn = $filelist->file_at($i);
    my ($f, $suffix) = parseFileSuffix($fn);
    if (Treex::PML::IO::is_same_file(_filelistFullFileName($filelist,$f),$old_file)) {
      my $pattern_no = $filelist->file_pattern_index($i);
      my $pattern = $pattern_list->[$pattern_no];
      my $new_filename =  (Treex::PML::_is_absolute($f) ?
	  $filename.$suffix : $rel_name.$suffix);
      $filelist->files_ref->[$i][0] = $new_filename;
      if ($pattern eq $fn) {
	# direct filename - easy: change pattern
	$pattern_list->[$pattern_no] = $new_filename;
      }
      # 	      elsif (!$fixed{$pattern_no}) {
      # 		my $new_pattern = QueryString($win,
      # 					      "Update filelist pattern",
      # 					      "Pattern:",
      # 					      $pattern,
      # 					    undef,
      # 					      undef,
      # 					      "File list reference\n${f}\n".
      # 						"is generated from a pattern. ".
      # 					    "You can now manually update the pattern.");
      # 		if (defined $new_pattern) {
      # 		  $pattern_list->[$pattern_no] = $new_pattern;
      # 		  $fixed{$pattern_no}=1;
      # 		}
      # 	      }
    }
  }
}

sub askSaveFiles {
  my ($grp,$cancelbutton)= @_;

  @{$grp->{treeWindows}} = grep { $_ ne $grp->{focusedWindow} } @{$grp->{treeWindows}};
  unshift @{$grp->{treeWindows}},$grp->{focusedWindow};
  my $win;
  my %asked;
  foreach $win (@{ $grp->{treeWindows} }) {
    if ($win->{FSFile}) {
      $asked{$win->{FSFile}}=1;
      focusCanvas($win->canvas(),$win->{framegroup});
      return -1 if askSaveFile($win,0,$cancelbutton) == -1;
      closeFile($win,-no_update => 1,-all_windows => 1);
    }
  }

  for my $fsfile (grep { !$asked{$_} and ref($_) and $_->notSaved } @openfiles) {
    resumeFile($grp->{focusedWindow},$fsfile);
    updateTitle($grp);
    get_nodes_win($grp->{focusedWindow});
    redraw_win($grp->{focusedWindow});
    centerTo($grp->{focusedWindow},$grp->{focusedWindow}->{currentNode});
    $grp->{top}->update();
    return -1 if askSaveFile($grp->{focusedWindow},0,$cancelbutton) == -1;
  }
  closeAllFiles($grp);
}

sub closeAllFiles {
  my ($grp)= @_;

  @{$grp->{treeWindows}} = grep { $_ ne $grp->{focusedWindow} } @{$grp->{treeWindows}};
  unshift @{$grp->{treeWindows}},$grp->{focusedWindow};
  my $win;
  foreach $win (@{ $grp->{treeWindows} }) {
    if ($win->{FSFile}) {
      closeFile($win,-no_update => 1,-all_windows => 1);
    }
  }
  while (@openfiles) {
   my $fsfile = $openfiles[0];

   # to avoid infinite loop, first try closing all files this one is
   # part of
   if ($fsfile and ref($fsfile->appData('fs-part-of'))) {
     foreach (@{$fsfile->appData('fs-part-of')}) {
       __debug("Closing all parts of ".$fsfile->filename);
       closeFile($grp->{focusedWindow},-fsfile => $_,
		 -no_update => 1, -all_windows => 1);
     }
   }
   __debug("Now closing file ".$fsfile->filename);
   closeFile($grp->{focusedWindow},
	     -fsfile => $fsfile,
	     -no_update => 1,
	     -all_windows => 1);
   if (grep {$_==$fsfile} @openfiles) {
     # still there?
     __debug("File still open, pushing it to the end: $fsfile: ".$fsfile->filename);
     shift @openfiles;
     push @openfiles, $fsfile;
     __debug("Open files: @openfiles");
   }
  }
}


# ask user whether the current file should be saved (and save it if yes)
# if $keepbutton parameter is 1, allow user to keep the file
# return 0 if file saved, 1 if file should be kept and undef if no

sub askSaveFile {
  my ($win,$keepbutton,$cancelbutton,$fsfile)=@_;
  $fsfile ||= $win->{FSFile};
  return 0 unless
    ref($fsfile) and
      $fsfile->notSaved;
  my $answer=userQuery($win,
			$fsfile->filename().
			"\n\nFile may be changed!\nDo you want to save it?",
			-bitmap=> 'question',
			-title => "Should I save the file?",
			-buttons => ['Yes', 'No', $keepbutton ? 'Keep' : (),
				     $cancelbutton ? 'Cancel' : ()]);
  if ($answer eq 'Yes') {
    return saveFile($win,$fsfile) == -1 ? -1 : 0;
  } elsif ($answer eq 'Keep') {
    return 1;
  } elsif ($answer eq 'Cancel') {
    return -1;
  }
}

sub saveConfig {
 my ($win,$config)=@_;
 my $top;
 if (ref($win)=~/^Tk::/) {
   $top = $win->toplevel;
 } else {
   $top = $win->{top};
 }
 my ($default_trc)=File::Spec->catfile($libDir,'tredrc');
 if (Treex::PML::IO::is_same_file($configFile,$default_trc)) {
   $configFile = File::Spec->catfile($ENV{HOME},'.tredrc');
 }
 my $exists = -e $configFile ? 1 : 0;
 if (!$exists or (-f $configFile and -w $configFile)) {
    my $renamed = rename $configFile, "${configFile}~" if $exists;
    if (open(my $fh,">$configFile")) {
      print STDERR "Saving tred configuration to: $configFile\n" unless $opt_q;
      print $fh (@$config);
      close($fh);
      return;
    } elsif ($renamed) {
      rename "${configFile}~", $configFile;
    }
  }
 # otherwise something went wrong
 { 
   my $lasterr=conv_from_locale($!);
   my ($trc)=File::Spec->catfile($ENV{HOME},'.tredrc');
   if (!Treex::PML::IO::is_same_file($configFile,$trc)  and
       ((defined($top) and
	   $top->
	     messageBox(-icon=> 'warning',
			-message=> "Cannot write configuration to $configFile: $lasterr\n\n".
			  "Shell I try to save it to ~/.tredrc?\n",
			-title=> 'Configuration cannot be saved',
			-type=> 'YesNo',
			# -default=> 'Yes' # problem: Windows 'yes', UNIX 'Yes'
		       )=~ m(yes)i) or 
	 (!defined($top) and ! -f $trc and !defined($opt_c)))) {
     my $renamed = rename $trc, "${trc}~";
     if (open(my $fh,">".$trc)) {
       print STDERR "SAVING CONFIG TO: $trc\n";
       print $fh (@$config);
       print STDERR "done\n";
       close($fh);
       $configFile=$trc;
     } else {
       rename("${trc}~", $trc) if $renamed;
       errorMessage($top,"Cannot write to \"$trc\": $lasterr!\n".
		    "\nConfiguration could not be saved!\nCheck file and directory permissions.",1);
     }
   } else {
     errorMessage($top,"Cannot write to \"$configFile\": $lasterr!\n".
		  "\nConfiguration could not be saved!\nCheck file and directory permissions.",1);
   }
 }
}

sub reconfigure {
  my ($grp)=@_;
  addToRecent($grp);
  prepareFonts($grp);
  updateTitle($grp);
  $grp->{top}->optionAdd("*font",$guiFont) if $guiFont;
  $grp->{valueLine}->configure(-font=> $vLineFont);
  $grp->{statusLine}->configure(-font=> $vLineFont) if $grp->{statusLine};
  foreach (@{$grp->{treeWindows}}) {
    $_->treeView->apply_options($treeViewOpts);
  }

  ApplyGlobalConfig($grp);
}

sub editConfig {
  my ($grp)=@_;
  return unless $grp;
  if ($grp->{configDialog}) {
    $grp->{configDialog}->deiconify;
    $grp->{configDialog}->focus;
    $grp->{configDialog}->raise;
    return;
  }
  $grp->{configDialog}= 
    $grp->{top}->Toplevel(-title=> "Edit Config File ($configFile)" , 
			  -width=> "10c");
  my $d=$grp->{configDialog};
  $d->withdraw;
  $d->BindReturn($d,1);
  my @text_opt = eval { require Tk::CodeText; 
			require Tk::CodeText::TrEdConfig; 
		      } ? (qw(CodeText -syntax TrEdConfig -commentchar ;))
			: qw(Text);
  my $t= $d->Scrolled(@text_opt, 
		      qw/-relief sunken -borderwidth 2
			-height 20 -scrollbars oe/);
  my $edit = $t->Subwidget('scrolled');
  _deleteMenu($edit->menu,'File');
  if ($text_opt[0] eq 'CodeText') {
    my $syntax = $edit->menu->entrycget('View','-menu')->entrycget('Syntax','-menu');
    my $last = $syntax->index('last');
    if ($last ne 'none') {
      $syntax->delete($_) for grep { defined and !/^(None|Perl|TrEdConfig)$/ }
	map { eval { local $SIG{__DIE__}; $syntax->entrycget($_,'-label')} } 0..$last
    }
    $edit->menu->entrycget('View','-menu')->delete('Rules Editor');
  }
  $t->bind('<Alt-f>'  => sub {
	     my ($w)=@_;
	     my $pop=$w->FindPopUp();
	     my ($entry) = grep { $_->isa('Tk::Entry') } $pop->children();
	     $pop->bind('<Tab>',[sub { shift->focusNext; }]);
	     $pop->bind('<Escape>',[sub { shift; shift->destroy; },$pop]);
	     if (ref($entry)) {
	       $entry->focus();
	     }
	   });
  $t->bind('<Alt-r>'  => sub {
	     my ($w)=@_;
	     my $pop=$w->FindAndReplacePopUp();
	     my ($entry) = grep { $_->isa('Tk::Entry') } $pop->children();
	     $pop->bind('<Tab>',[sub { shift->focusNext; }]);
	     $pop->bind('<Escape>',[sub { shift; shift->destroy; },$pop]);
	     if (ref($entry)) {
	       $entry->focus();
	     }
	   });
  $t->pack(qw/-side top -expand yes -fill both/);

  disable_scrollbar_focus($t);
  $t->BindMouseWheelVert();
  my $bottom=$d->Frame()->pack(qw/-side bottom -fill x/);
  $t->TextSearchLine(-parent => $d,
		     -label=>'S~earch',
		     -prev_img =>icon($grp,'16x16/up'),
		     -next_img =>icon($grp,'16x16/down'),
		    )->pack(qw(-fill x -side top));

  $bottom->
    Button(-text=> "  Save and Apply  ",
	   -underline => 2,
	   -command=> [sub {
			  my ($grp,$d,$t)=@_;
			  saveConfig($d,[$t->get("0.0","end")]);
			  apply_config(split(/\n/,$t->get("0.0","end")));
			  reconfigure($grp);
			  get_nodes_all($grp);
			  redraw_all($grp);
			},$grp,$d,$t])
      ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "  Apply  ",
		  -underline => 2,
		  -command=> [sub {
				 my ($grp,$w)=@_;
				 apply_config(split(/\n/,$w->get("0.0","end")));
				 reconfigure($grp);
				 get_nodes_all($grp);
				 redraw_all($grp);
			       },$grp,$t])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "  Help  ", 
		  -underline => 2,
		  -command=> [sub { 
				help_topic(shift,'configuration'); 
				Tk->break;
			      },$d])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "  Close  ", 
		  -underline => 2,
		  -command=> [sub { shift->destroy; },$d])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $d->BindButtons;
  $d->bind('<Destroy>'=> [sub { shift; shift->{configDialog}=undef; },$grp ]);
  $d->bind($d,'<Escape>'=> [sub { shift; shift->destroy(); },$d]);
  my $config = getConfigFromFile()||[];
  updateRuntimeConfig($grp,$config);
  $t->insert('0.0',join(EMPTY,@$config)."\n");
  $t->mark(qw/set insert 0.0/);
  $t->focus();
  $d->Popup;
}

sub QueryString {
  my ($grp, $title, $label,$default_text, $select, $hist,$before_label,$opts)=@_;
  my $top = (ref($grp) and UNIVERSAL::can($grp,'toplevel')) ? $grp->toplevel : $grp->{top};
  my $newvalue=encode($default_text);
  my $d=$top->DialogBox(-title=> $title,
				 -buttons=> ["OK", "Cancel"]);
  $d->BindEscape();
  $d->BindReturn($d,1);
  $d->bind('<Tab>',[sub { shift->focusNext; }]);
  $d->bind('<Shift-Tab>',[sub { shift->focusPrev; }]);

  addBindTags($d,'dialog');
  $opts||={};
  my ($Entry,@Eopts) = @{delete($opts->{-entry}) || [get_entry_type()]};

  my $f = $d;
  if (defined $before_label) {
    my $l= $d->Label(-text=> encode($before_label),
		   -anchor=> 'ne',
		   -justify=> 'left')->pack();
    $f=$d->Frame->pack();
  }
  my $e=$f->$Entry(
		@Eopts,
		-relief=> 'sunken',
		-width=> 70,
		-takefocus=> 1,
		-font=> $font,
		-textvariable=> \$newvalue);
  if ($opts->{-entry_config}) {
    $opts->{-entry_config}->($e);
  }
  if ($e->can('history') and ref($hist)) {
    $e->history($hist);
  }
  $e->selectionRange(qw(0 end)) if ($select);
  my $l= $f->Label(-text=> encode($label),
		    -anchor=> 'e',
		    -justify=> 'right');

  $l->pack(-side=>'left');
  $e->pack(-side=>'right');
  $d->resizable(0,0);
  $d->BindButtons;
  my $result= ShowDialog($d,$e,$top);
  if ($result=~ /OK/) {
    if (ref($hist) and $e->can('historyAdd')) {
      $e->historyAdd($newvalue) if $newvalue ne EMPTY;
      @$hist = $e->history();
    }
    $d->destroy; undef $d;
    return decode($newvalue);
  } else {
    $d->destroy; undef $d;
    return undef;
  }
}

sub Query {
  my ($w, $title, $label,$default_text,$select, $hist)=@_;
  my $newvalue=encode($default_text);
  my $d=$w->DialogBox(-title=> $title,
				 -buttons=> ["OK", "Cancel"]);
  $d->BindReturn($d,1);
  $d->BindEscape;
  addBindTags($d,'dialog');
  my ($Entry,@Eopts) = get_entry_type();
  my $e=$d->add($Entry,-relief=> 'sunken',
		    -width=> 40,
		    -takefocus=> 1,
		    -font=> $font,
		    -textvariable=> \$newvalue);
  if ($e->can('history') and ref($hist)) {
    $e->history($hist);
  }
  $e->selectionRange(qw(0 end)) if ($select);
  my $l= $d->Label(-text=> encode($label),
		    -anchor=> 'e',
		    -justify=> 'right');
  $l->pack(-side=>'top');
  $e->pack(-side=>'left');
  $d->resizable(0,0);
#  $e->focus;
  $d->BindButtons;
  my $result= ShowDialog($d,$e,$w);
  if ($result=~/OK/) {
    if (ref($hist) and $e->can('historyAdd')) {
      $e->historyAdd($newvalue) if $newvalue ne EMPTY;
      @$hist = $e->history();
    }
  }
  $d->destroy;
  undef $d;
  if ($result=~ /OK/) {
    return decode($newvalue);
  } else {
    return undef;
  }
}

sub listQuery {
  my ($w,$title,$select_mode,$vals,$selected,%opts)=@_;
  my $top=$w->toplevel;
  my $d=$w->DialogBox(-title	  => $title,
		      -width	  => '8c',
		      -buttons  => ["OK", "Cancel"],
		      ref($opts{dialog}) ? %{$opts{dialog}} : (),
		     );
  $d->BindReturn($d,1);
  $d->BindEscape();
  if (ref($opts{label})) {
    $d->Label(%{$opts{label}})->pack(qw/-side top/);
  }
  my $l=$d->Scrolled(qw/Listbox -relief sunken
                        -takefocus 1
                        -width 0
                        -scrollbars e/,
		     -font=> $font,
		     -selectmode => $select_mode,
		     -height=> min($maxDisplayedValues,scalar(@$vals)),
		     ref($opts{list}) ? %{$opts{list}} : ()
		    )->pack(qw/-expand yes -fill both/);
  $l->insert('end',@$vals);
  if (@$vals>0) {
    $l->activate(0);
  }
  $l->BindMouseWheelVert();
  my $f=$d->Frame()->pack(qw/-fill x/);
  if ($select_mode eq 'multiple') {
    $f->Button(-text => 'All',
	       -underline => 0,
	       -command => [
			    sub{
			      my ($list)=@_;
			      $list->selectionSet(0,'end');
			    },
			    $l
			   ])->pack(-side => 'left');
    $f->Button(-text => 'None',
	       -underline => 0,
	       -command => [
			    sub{
			      my ($list)=@_;
			      $list->selectionClear(0,'end');
			    },
			    $l
			   ])->pack(-side => 'left');
  } else {
    $l->bind('<Double-1>', sub { $d->{selected_button}='OK' });
  }
  if (ref($opts{buttons})) {
    foreach my $b (@{$opts{buttons}}) {
      if (ref($b->{-command}) eq 'ARRAY') {
	push @{$b->{-command}}, $l;
      }
      $f->Button(%$b)->pack(-side => 'left');
    }
  }
  Tk::Callback->new($opts{init})->Call($d,$l,$f) if $opts{init};
  $d->BindButtons;
  my $act=0;
  my %selected = map { $_ => 1 } @$selected;
  for ($a=0;$a<@$vals;$a++)  {
    if ($selected{$$vals[$a]}) {
      $l->selectionSet($a);
      if (not $act) {
	$act=1;
	$l->activate($a);
	$l->see($a);
      }
    }
  }
 $l->focus;
 my $result= &main::ShowDialog($d,$l,$top);

 if ($result!~ /Cancel/) {
   @$selected=();
   my @ret;
   foreach (0 .. $l->size-1) {
     if ($l->selectionIncludes($_)) {
       push @$selected, $l->get($_);
       push @ret, $_;
     }
   }
   $d->destroy;
   return \@ret;
 }
 $d->destroy;
 return undef;
}

sub autoSelectContext {
  my ($grp)=@_;
  my ($win)=$grp->{focusedWindow};
  if ($win->{FSFile}) {
    my $prevcontext = $win->{macroContext};
    $win->{macroContext}='TredMacro';
    doEvalHook($win,"guess_context_hook","file_resumed_hook");
    if ($win->{macroContext} eq 'TredMacro' and $prevcontext ne 'TredMacro') {
      $win->{macroContext}=$prevcontext;
      switchContext($win,'TredMacro');
    } else {
      get_nodes_win($win); # the hook may have changed something
      redraw_win($win);
      centerTo($win,$win->{currentNode});
    }
  } else {
    switchContext($win,'TredMacro');
  }
}
sub getApplicableContexts {
  my ($win)=@_;
  my $prevcontext = $win->{macroContext};
  my @ret = grep { (doEvalHook($win,"allow_switch_context_hook",$prevcontext,$win->{macroContext}=$_)||'') ne 'stop' } getContexts();
  $win->{macroContext}=$prevcontext;
  return @ret;
}

sub selectContext {
  my ($grp)=@_;
  my $win = $grp->{focusedWindow};
  my $selection = [$win->{macroContext}];
  listQuery($grp->{top},'Select Mode','browse',[getApplicableContexts($win)],
	    $selection) || return;
  if (@$selection) {
    switchContext($grp->{focusedWindow},$selection->[0]);
  }
}

sub selectStylesheet {
  my ($grp_or_win)=@_;
  my $grp = cast_to_grp($grp_or_win);
  my $win = cast_to_grp($grp_or_win);
  my $selection = [$grp->{selectedStylesheet}];
  listQuery($grp->{top},'Select Mode','browse',
	    getStylesheetMenuList($grp),
	    $selection) || return;
  if (@$selection) {
    $grp->{selectedStylesheet} = $selection->[0];
    switchStylesheet($grp,$selection->[0]);
  }
}

sub stylesheetUsingWindows {
  my ($grp,$stylesheet)=@_;
  return 
    grep {
      $_->{stylesheet} eq $stylesheet
    } @{$grp->{treeWindows}};
}


sub deleteStylesheet {
  my ($grp,$stylesheet)=@_;
  removeStylesheetFile($grp,$defaultStylesheetPath,$stylesheet);
  updateStylesheetMenu($grp);
  foreach my $win (stylesheetUsingWindows($grp,$stylesheet)) {
    if ($grp->{focusedWindow} == $win) {
      $grp->{selectedStylesheet} = STYLESHEET_FROM_FILE();
    }
    applyWindowStylesheet($win,STYLESHEET_FROM_FILE());
    if ($win->{FSFile}) {
      get_nodes_win($win);
      redraw_win($win);
    }
  }
}

sub selectValuesDialog {
 my ($grp, $attr, $vals, $selected, $may_add, $lastFocus,$force)=@_;
 my $a;
 my $multi=0;
 my @prevSelectionSet;

 my $top=$grp->{top};
 $top->Busy(-recurse=> 1);
 my $enabled=($force or doEvalHook($grp->{focusedWindow},
				   'enable_attr_hook',
				   $attr,
				   "ambiguous") ne 'stop');

 my $d=$top->DialogBox(-title=> ($enabled ? "$attr: select values" : "$attr: values"),
		       -width=> '8c',
		       -buttons=> ($enabled ? ["OK", "Cancel"] : ["Cancel"]));
 $d->BindReturn($d,1);
 $d->BindEscape();
 $d->resizable(0,0);
 my $l=$d->Scrolled(qw/Listbox -relief sunken -takefocus 1 -scrollbars oe/,
		    -height=> min($maxDisplayedValues,scalar(@$vals)),
		    -font=> $font)->pack(qw/-expand yes -fill both/);
 disable_scrollbar_focus($l);
 $l->insert('end',@$vals);
 $l->BindMouseWheelVert();
 if ($enabled) {
   $l->bind('<Double-ButtonPress-1>'=>
	    [sub { my $w=shift;
		   my $d=shift;
		   my $e= $w->XEvent;
		   $w->BeginSelect($w->index($e->xy));
		   $d->{selected_button}='OK';
		 },$d
	    ]);
 }
 my $act=0;
 for ($a=0;$a<@$vals;$a++)  {
   if (grep { $$vals[$a] eq $_ } @$selected) {
     $l->selectionSet($a);
     if (not $act) {
       print "Activating $a\n"  if $tredDebug;
       $act=1;
       $l->activate($a);
       $l->see($a);
     }
   }
 }
 if ($enabled) {
   $d->Checkbutton(-text    => 'multiple select',
		   -variable=> \$multi,
		   -command => [sub {
				   shift->configure(-selectmode=> $multi ? 'multiple' : 'browse');
				 },$l],
		   -relief  => 'flat')->pack();
   if ($may_add) {
     $d->Button(-text=> 'Add',
		-command=> [sub {
			       my ($grp,$l,$vals,$attr)=@_;
			       $grp->{"histValue:$attr"}=[]
				 unless $grp->{"histValue:$attr"};
			       my $val=
				 QueryString($grp,"Add new value","Value",
					     undef,
					     0,$grp->{"histValue:$attr"});
			       return unless defined $val;
			       push @$vals,$val;
			       $l->insert('end',$val);
			       $l->selectionClear(0,$l->size-1) unless $multi;
			       $l->selectionSet($l->size-1);
			     },$grp,$l,$vals,$attr])->pack();
   }
 }
 $top->Unbusy();
 $l->focus;
 $d->BindButtons;
 my $result= ShowDialog($d,$l,$lastFocus);
 if ($result=~ /OK/) {
   # Hajic wanted this (I wash my hands):
   # first we store the values, which were selected originaly and
   # stayed selected
   foreach my $s (@$selected) { 
     push @prevSelectionSet, (grep { $$vals[$_] eq $s } (0 .. $l->size-1));
   }
   @$selected=();
   foreach (@prevSelectionSet) {
     if ($l->selectionIncludes($_)) {
       $l->selectionClear($_);
       push @$selected,$$vals[$_];
     }
   }
   foreach (0 .. $l->size-1) {
     push @$selected, $$vals[$_] if $l->selectionIncludes($_);
   }
   $d->destroy;
   undef $d;
   return 1;
 }
 $d->destroy;
 undef $d;
 return 0;
}

sub reloadSentenceView {
  my ($grp,$t,$selref)=@_;
  return unless $t;
  my $d=$grp->{sentDialog};
  $t->delete('0.0','end'); #something smells here!! 
  $grp->{sentDialog}=$d;
  my $filename=$grp->{focusedWindow}->{FSFile}->filename();
  for (my $i=0; $i<=$grp->{focusedWindow}->{FSFile}->lastTreeNo();$i++) {
    $t->window('create', 'end', -window =>
	       $t->Checkbutton(-selectcolor => undef,
			       -indicatoron => 0,
			       -height => 25,
			       -width => 25,
			       -background=>'white',
			       -relief => 'flat',
			       -borderwidth => 0,
			       -padx => 5,
			       -pady => 5,
			       -selectimage => icon($grp,"checkbox_checked"),
			       -image => icon($grp,"checkbox"),
			       -variable => \$selref->[$i]
			      ));
    $t->window('create', 'end', -window =>
	       $t->Button(-height => 19,
			  -width => 19,
			  -background=>'white',
			  -relief => 'flat',
			  # -borderwidth => 0,
			  -padx => 0,
			  -pady => 0,
			  -image => icon($grp,'1rightarrow'),
			  -command => [\&openFile, $grp, "$filename##".($i+1)]
			 ));

    my $v = get_value_line($grp->{focusedWindow},
			   $grp->{focusedWindow}->{FSFile},$i,1,1,'sent_list');
    my %tags;
    if (ref($v)) {
      @tags{ map { @$_[1..$#$_] } @$v }=();
      foreach my $tag (keys(%tags)) {
	if ($tag=~/^\s*-/) {
	  eval {
	    $t->tagConfigure(
	      $tag => (map { (/^\s*(-[[:alnum:]]+)\s*=>\s*(.*\S)\s*$/) }
			 split(/,/,$tag)));
	  };
	  print $@ if $@;
	}
      }
    } else {
      $v = [ map [$_], split /(\n)/, $v ];
    }
    my $collapse=0;
    $t->insert('end',"(".($i+1).") ",['treeno',"start-tree-".($i+1)],
	       map {
		  my $l = $v->[$_];
		  my $t = $l->[0];
		  my @t = @$l[1..$#$l];
		  if (!$collapse and $_<$#$v and $t=~s/(\n\s*)$//) {
		    $collapse=1;
		    ($t,\@t,"...",["#collapse_bar#","#collapse_bar_$i#"],$1,["#collapse_$i#"])
		  } else {
		    push @t, "#collapse_$i#" if $collapse;
		    ($t, \@t)
		  }
		} 0..$#$v);
    if ($collapse) {
      $t->tagBind("#collapse_bar_$i#",'<Any-Enter>', => [sub { $_[0]->tagConfigure("#collapse_bar_$_[1]#", -background => 'cyan') },$i]);
      $t->tagBind("#collapse_bar_$i#",'<Any-Leave>', => [sub { $_[0]->tagConfigure("#collapse_bar_$_[1]#", -background => undef) },$i]);
      $t->tagConfigure("#collapse_$i#", -elide => 0);
      $t->tagBind("#collapse_bar_$i#",'<1>', => [sub {
		    my ($w,$i)=@_; 
		    $w->tagConfigure("#collapse_$i#",
				     -elide => $w->tagCget("#collapse_$i#",'-elide') ? 0 : 1) },$i]);
    }
    $t->insert('end',"\n",['newline',"end-tree-".($i+1), "#collapse_$i#"
			  ]);
	       #	       get_value_line($grp->{focusedWindow},
	       #			      $grp->{focusedWindow}->{FSFile},$i,1),'tline',
    #	       "\n",'newline');
  }
  $t->tagAdd('all','0.0','end');
  $t->tagConfigure('all',-lmargin2 => 50);
}

sub sentViewSelectAll {
  my ($grp,$selref)=@_;
  return unless ref($selref) eq 'ARRAY';
  foreach (@{$selref}) {
    $_=1;
  }
}

sub sentViewSelectNone {
  my ($grp,$selref)=@_;
  return unless ref($selref) eq 'ARRAY';
  foreach (@{$selref}) {
    $_=0;
  }
}

sub sentViewGetSelection {
 my ($grp,$selref)=@_;
 $selref||=$grp->{sentDialogSelection};
 my $rng=EMPTY;
 
 if (ref($selref) eq 'ARRAY') {
   for (my $i=0;$i<=$#{$selref};$i++) {
     $rng.=($i+1)."," if $selref->[$i];
   }
   $rng=~s/,$//;
 }
 return $rng;
}

sub sentViewToggleCollapse {
 my ($grp,$t,$val)=@_;
 if (!defined $val) {
   $val = $grp->{expandSentView};
 }
 $t->tagConfigure('#collapse_bar#',
		  -elide => $val ? 0 : 1);
 my $i=0;
 undef $@;
 do {{
   eval {
     $t->tagCget("#collapse_$i#",'-elide'); # dies if the tag does not exist
     $t->tagConfigure("#collapse_$i#", -elide => $val ? 1 : 0);
   };
   $i++
 }} while (!$@);
}

sub viewSentences {
  my ($grp)=@_;
  return unless $grp and ref($grp->{focusedWindow}->{FSFile});
  if ($grp->{sentDialog}) {
    my $d=$grp->{sentDialog};
    $d->deiconify;
    $d->focus;
    $d->raise;
    return;
  }
  $grp->{sentDialogSelection}=[];
  my $d=$grp->{sentDialog}=
    $grp->{top}->Toplevel(-title=> "List of sentences for ".
			  $grp->{focusedWindow}->{FSFile}->filename(),
			  -width=> "10c");
  $d->withdraw;
  $d->bind('<Return>'=> [\&Tk::Widget::_DialogReturn,1]);
  $d->bind('<Escape>'=> [sub { $_[1]->destroy(); },$d]);
  $d->bind('<Destroy>'=> [sub { $_[1]->{sentDialog}=undef; },$grp ]);
  populateSentencesDialog($grp,$grp->{sentDialog},
			  $grp->{focusedWindow}->{FSFile},
			  $grp->{sentDialogSelection},
			  1
			 );
  $d->Popup;
}

sub viewSentencesDialog {
  my ($grp,$top,$fsfile,$selref)=@_;
  return unless $grp and ref($grp->{focusedWindow}->{FSFile});
  my $d=
    $top->DialogBox(-title=> "List of sentences for ".
		    $fsfile->filename(),
		    -width=> "10c");
  $d->BindReturn($d,1);
  $d->BindEscape();
  $selref||=[];
  populateSentencesDialog($grp,$d,$fsfile,$selref,0);
  ShowDialog($d,$top);
  $d->destroy;
  undef $d;
  return $selref;
}

sub openSimpleHtml {
  my ($top,$file,$title,$initdir) = @_;
  $file= get_save_filename($top->toplevel,
			   -filetypes=>
			   [["HTML",  ['.html','.htm','.HTM','.HTML']],
			    ["All files",        "*"]],
			   -title=> $title,
			   -d $initdir ? (-initialdir=> $initdir) : (),
			   $^O eq 'MSWin32' ? () : (-initialfile=> filename($file)));
  if (defined($file) and $file ne EMPTY) {
    open my $html, ">$file" ||
      errorMessage($top,"Cannot write to \"$file\"!"."\n(".conv_from_locale($!)."\nCheck file and directory permissions.\n".
		     "\nSentences could not be saved!",1);
    my $encoding=$TrEd::Convert::outputenc;
    if ($TrEd::Convert::support_unicode) {
      setFHEncoding($html,$encoding,"html-out");
    } else {
      setFHEncoding($html,':bytes',"html-out");
    }
    print $html "<html>\n";
    print $html "<head>\n";
    print $html "  <meta http-equiv=\"Content-Type\" content=\"text/html;charset=".$encoding."\" />\n";
    print $html "</head>\n";
    print $html "<body>\n";
    return wantarray ? ($html,$file) : $html;
  } else {
    return undef;
  }
}

sub closeSimpleHtml {
  my ($html) = @_;
  print $html "\n</body>\n";
  print $html "\n</html>\n";
  close($html);
}

sub dumpSentView {
  my ($grp, $fsfile, $t, $create_images, $selref)=@_;

  my $win = $grp->{focusedWindow};
  return if ($create_images and warnWin32PrintConvert($t) eq 'Cancel');

  sentViewToggleCollapse($grp,$t,1);

  my $file=$fsfile->filename;
  $file=~s/\.(?:csts|sgml|sgm|cst|trxml|trx|tei|xml|fs|pls)(?:\.gz)?$/.html/i;

  my $initdir=dirname($file);
  $initdir=cwd if ($initdir eq './');
  $initdir=~s!${TrEd::Convert::Ds}$!!m;

  my @selref = split /,/,sentViewGetSelection($grp,$selref);
  unless (@selref) {
    errorMessage($t->toplevel,"No sentences selected. Select requested sentences and try again. To select a sentence, click the round button in front of it.",1);
    return;
  }

  my $errors;

  (my $html,$file) = openSimpleHtml($t,$file,"Save Sentences As HTML ...",$initdir);
  my $ttfont = $grp->{ttfonts} ? $grp->{ttfonts}->{$printOptions->{ttFont}} : undef;
  my $dpi = int($grp->{top}->fpixels('1i'));

  if (defined($html)) {
    my @dump=$t->dump('0.0','end'); # to avoid a bug ??
    @dump = map $t->dump("start-tree-$_.first","end-tree-$_.last"), @selref;
    # @dump=$t->dump('0.0','end');
    my $img;

    # there seems to be a bug in Dump which prevents dumping tagoff
    # for the last open element on a line

    while (@dump) {
      my ($K,$V,$I) = splice @dump, 0, 3;
      if ($K eq 'tagon') {
	if ($V eq 'treeno') {
	  $img=1;
	  print $html "<div class=\"TREE\">";
	  print $html "<p>";
	} else {
	  print $html "<u>" if $t->tagCget($V,'-underline');
	  print $html "<font color=\"".$t->tagCget($V,'-foreground')."\">"
	    if $t->tagCget($V,'-foreground');
	  print $html "<span class=\"$1\">" if $V =~ /^tag\s*=>\s*(.*)$/;
	}
	if ($V eq 'newline') {
	  print $html "</p>\n";
	  print $html "</div>\n";
	  print $html "<hr />\n" if $create_images;
	}
      } elsif ($K eq 'tagoff') {
	print $html "</span>" if $V =~  /^tag\s*=>\s*.*$/ ;
	print $html "</font>" if $t->tagCget($V,'-foreground');
	print $html "</u>" if $t->tagCget($V,'-underline');
	$img=0 if $img;
      } elsif ($K eq 'text') {
	if ($img and $create_images) {
	  # create image filename
	  my $img_file = $file;
	  my $no = $V; $no =~ s/[()]|\s*//g;
	  $img_file =~ s/\.[^.]*$/_${no}.png/;
	  print $html "<img src=\"".filename($img_file)."\"/><br />\n";
	  # create image
	  my $canvas=$grp->{top}->Canvas();
	  my $stylesheet = $win->{stylesheet};
	  my $ss = undef;
	  if ($stylesheet ne STYLESHEET_FROM_FILE()) {
	    $ss=$win->{framegroup}->{stylesheets}->{$stylesheet};
	  }
	  eval {
	    TrEd::Print::Print({
	      -context => $win,
	      -toplevel => $grp->{top},
	      -fsfile => $fsfile,
	      -canvas => $canvas,

	      -filename => $img_file,
	      -to => 'convert',
	      -convert => $imageMagickConvert,
	      -imageMagickResolution => $dpi,
	      -range => $no,

	      ($ttfont ? (
		-format => 'PDF',
		-ttFont => $ttfont,
	       ) : (
		 -format => 'EPS',
		 -psFontFile => $printOptions->{psFontFile},
		 -psFontAFMFile => $printOptions->{psFontAFMFile},
	       )),

	      -styleSheetObject=>$ss,
	      -hidden => $win->{treeView}->get_showHidden(),
	      -fontSize => $printOptions->{psFontSize},
	      -treeViewOpts => $treeViewOpts,

	      -onGetRootStyle => \&onGetRootStyle,
	      -onGetNodeStyle => \&onGetNodeStyle,
	      -onGetNodes => \&printGetNodesCallback,
	      -onRedrawDone => \&onRedrawDone,
	    });
	  };
	  $errors .= $@ if $@;

	  $canvas->destroy();
	  $img=0;
	}
	$V=~s{&}{&amp;}g;
	$V=~s{<}{&lt;}g;
	$V=~s{\t}{     }g;
	$V=~s{\n}{<br/>}g;
	$V=~s{ ( +)}{' '.('&nbsp;'x length($1))}eg;
	print $html $V;
      } else {
#	print $html "<other key=\"$K\" value=\"$V\"/>";
      }
    }
    closeSimpleHtml($html);
    get_nodes_win($win); # printGetNodesCallback may have fiddled with $win
  }
  errorMessage($win,$errors) if defined $errors;
  return $file;
}

sub populateSentencesDialog {
  my ($grp,$d,$fsfile,$selref,$close_button)=@_;
  return unless $grp and $fsfile;

  use Tk::ROText;
#c -background white
# -spacing3 6 
  my $t= $d->
    Scrolled(qw/ROText -relief sunken -borderwidth 2 -setgrid true
		     -wrap word
		     -height 20
		     -scrollbars oe/,
	     -font=>$font
	    );

  _deleteMenu($t->Subwidget('scrolled')->menu,'File');
  disable_scrollbar_focus($t);
  $t->pack(qw/-expand yes -fill both/);
  $t->TextSearchLine(-parent => $d,
		     -label=>'S~earch',
		     -prev_img =>icon($grp,'16x16/up'),
		     -next_img =>icon($grp,'16x16/down'),
		    )->pack(qw(-fill x));

  $t->BindMouseWheelVert();
  $grp->{sentDialogText}=$t;
  my $bottom=$d->Frame()->pack(qw/-expand 0 -fill x/);

  if ($close_button) {
    $bottom->Button(-text=> "Close",
		    -underline => 0,
		    -command=> [sub { $_[0]->destroy; },$d])
      ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  }

  $bottom->Button(-text=> "Reload",
		  -underline => 0,
		  -command=> [\&reloadSentenceView,$grp,$t,$selref])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "Select All",
		  -underline => 7,
		  -command=>[ \&sentViewSelectAll,$grp,$selref])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "Clear selection",
		  -underline => 1,
		  -command=>[ \&sentViewSelectNone,$grp,$selref])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "Save As HTML",
		  -underline => 0,
		  -command=>[ sub { open_url_in_browser(&dumpSentView) },$grp,$fsfile,$t,0,$selref])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $bottom->Button(-text=> "Save As HTML with Images",
		  -underline => 18,
		  -command=>[ sub { open_url_in_browser(&dumpSentView) },$grp,$fsfile,$t,1,$selref])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);

  $bottom->Checkbutton(-text=> "Shrink/Expand",
		  -underline => 0,
		  -variable => \$grp->{expandSentView},
		  -command=>[ \&sentViewToggleCollapse,$grp,$t])
    ->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  $d->BindButtons;
  reloadSentenceView($grp,$t,$selref);
}


sub editListAttr {
  my ($win, $value, $attr,$d, $node)=@_;
  return unless $win->{FSFile};
  my @vals= map { encode($_) } $win->{FSFile}->FS->listValues($attr);
  if ($sortAttrValues) {
    my @v = @vals;
    if (doEvalHook($win,"sort_attr_values_hook",\@v,$attr,$node)) {
      @vals = @v;
    } else {
      @vals = sort @vals
    }
  }
  #print "splitting ",$value{$attr},"\n";
  my @selected= map { encode($_) } split /\|/,$value;
  #print "splitted to ", join ('-',@selected),"\n";

  if (selectValuesDialog($win->{framegroup},$attr,\@vals,\@selected,0,$d)) {
    return decode(join('|',@selected));
  }
  return undef;
}

sub editAmbiguousAttr {
  my ($win, $value, $attr)=@_;
  my @vals= map { encode($_) }split /\|/,$value;
  my @selected= @vals;
  
  if (selectValuesDialog($win->{framegroup},$attr,\@vals,\@selected,1,$win->toplevel)) {
    return decode(join('|',@selected));
  }
  return undef;
}

sub focusxEditDn {
  my ($w,$i,$e,$f,$atord)=@_;
  if ($i+1<@$atord) {
    $f->see($e->{$atord->[$i+1]});
    $e->{$atord->[$i+1]}->focus;
  }
  Tk->break;
}

sub focusxEditUp {
  my ($w,$i,$e,$f,$atord)=@_;
  if ($i>0) {
    $f->see($e->{$atord->[$i-1]});
    $e->{$atord->[$i-1]}->focus;
  }
  Tk->break;
}

sub focusxFind {
  my ($w,$i,$e,$f,$atord)=@_;
  my $ev= $w->XEvent;
  my $A= $ev->A;
  if ($A ne EMPTY) {
    my $count=scalar(@$atord);
    for (my $j=$i+1;$j<=$i+$count;$j++) {
      if (($atord->[$j % $count]) =~ /^\Q$A\E/i) {
	$f->see($e->{$atord->[$j % $count]});
	$e->{$atord->[$j % $count]}->focus();
	Tk->break;
	return;
      }
    }
  }
}


sub determineNodeType {
  my ($win,$node)=@_;
  return unless $node;
  my $type = $node->type;
  return $type if $type;
  doEvalHook($win,'determine_node_type_hook',$node);
  $type = $node->type;
  return $type if $type;
  __debug("Determining node type for $node\n");
  eval {
    $win->{FSFile}->determine_node_type($node => {
      choose_command => sub {
	my (undef,undef,$ntypes)=@_;
	my $i = 1;
	my @types = map {($i++)." ".($_->[0])} @$ntypes;
	my $selection = [$types[0]];
	my $top = $win->toplevel;
	my ($highest) = reverse $top->stackorder();
	$top = $top->Widget($highest);
	listQuery($top,'Untyped node: select node-type','browse',
		  \@types,$selection) || return;
	return @$ntypes[$1-1] if $selection->[0]=~/^(\d+) /;
	return;
      }
    });
  };
  plainErrorMessage($win,$@) if $@;
  return $node->type;
}

sub editFilePropertiesDialog {
  my ($grp_or_win)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  my $top = $grp->{top};
  my $fsfile = $win->{FSFile};
  return unless $fsfile;
  my $trees_type = $fsfile->metaData('pml_trees_type');
  my $references = $fsfile->metaData('references');
  my $fsrequire = $fsfile->metaData('fsrequire');
  my $refnames = $fsfile->metaData('refnames');
  my %id2name = $refnames ? (reverse %$refnames) : ();
  my $schema = fileSchema($fsfile);
  my $text =join("\n",
		 "File Information",
		 "----------------",
		 "URI:\t". $fsfile->URL,
		 "I/O Backend:\t". $fsfile->backend,
		 "Trees:\t". ($fsfile->lastTreeNo + 1),
		 ($schema ?
		    ("\n\nPML Schema Information",
		     "----------------------",
		     "Rrevision:\t".$schema->get_revision(),
		     "Root name:\t".$schema->get_root_name(),
		     "Description:\t".$schema->get_description(),
		     "URI:\t".$schema->get_url(),
		     "Tree list type:\t".(ref($trees_type) ? $trees_type->get_decl_path : '-'),
		     (map { "\thas $_:\t".(ref($fsfile->metaData("pml_$_")) ? "yes" : "no") } qw(prolog epilog)  ),
		    )
		      : ()
		     ),
		 (
		   ref($references) ?
		     (
		       "\n\nPML References",
		       "--------------",
		       map {
			 my $name = $id2name{$_} || '';
			 $name = " [$name]" if $name;
			 "$_$name => $references->{$_}"
		       }  keys %$references)
		       : ()
		      ),
		 (
			 ref($fsrequire) ?
			 ("\n\nSecondary files",
			  "---------------",
			  (map { "$_->[0] => $_->[1]" }  @$fsrequire),
			 ) : ()
		       ),
		      );
  my $ret = $top->ErrorReport(
    -title   => 'Properties',
    -msgtype => ('INFORMATION'),
    -message => ("Current File Properties"),
    -body => $text,
    -buttons => ['Close',
		 (map {
		   $schema && ref($fsfile->metaData("pml_$_")) ? 'View '.ucfirst($_). ' Data' : ()
		 } qw(root prolog epilog))
		]
  );
  my $what = $ret;
  if ($what =~ s/ (.*) Data/$1/) {
    $what = 'pml_'.lc($1);
    my $type = $what eq 'pml_root' ? $schema->get_root_type : $trees_type;
    #    print STDERR "$what: ",$fsfile->metaData($what),"\t",$type,"\n";
    $top->TrEdNodeEditDlg({
      title => $ret,
      type => $type, # fixme: what data type for pml_epliog and pml_prolog?
      object => $fsfile->metaData($what),
      object_name => $what,
      search_field=>1,
      allow_trees=> $what eq 'pml_root' ? 0 : 1,
      enable_callback => sub { 0 },
      no_sort => 1,
      no_value_sort => !$sortAttrValues,
      side_panel_wrap => $sidePanelWrap,
    })
  }

  # $top->TrEdNodeEditDlg({
  #   title => 'Edit Properties',
  #   type => $cfg->schema->get_root_type,
  #   object => get_config(),
  #   search_field => 0,
  #   focus => 'context_before',
  #   no_sort=>1,
  # });

}


sub editAttrsDialog_schema {
  my ($win,$node,$attr_path,$as_type,$focus)=@_;
  my $grp = $win->{framegroup};
  my $base_type = ref($as_type) ? $as_type : determineNodeType($win,$node);
  return unless $base_type;
  my $schema;
  my $enabled = 1;
  my $node_type;

  $win->toplevel->Busy(-recurse=>1);
  if ($attr_path ne EMPTY) {
    $node_type = $base_type->find($attr_path,1);
    croak("Unknown attribute $attr_path") unless $node_type;
    $enabled = 0 if doEvalHook($win,'enable_attr_hook',$attr_path,"normal",$node) eq 'stop';
  } else {
    $enabled= 0 if (doEvalHook($win,'enable_edit_node_hook',$node) eq 'stop');
    $node_type = $base_type;
  }

  my $dlg_title = $attr_path ne EMPTY ? "Edit Attribute '$attr_path'" : "Edit Node";
  my $result = $win->toplevel->TrEdNodeEditDlg({
    title => $dlg_title,
    type => $base_type,
    object => $node,
    path => $attr_path,
    focus => (defined $focus ? $focus : $attr_path),
    buttons => [$enabled ? ($attr_path ? qw(OK Cancel) : qw(OK Help Cancel)) : ('Cancel')],
    no_sort=>!$sortAttrs,
    no_value_sort=>!$sortAttrValues,
    side_panel_wrap => $sidePanelWrap,
    buttons_configure => {
      Help => [ -command =>
		  [sub {
		     help_topic(shift,'new_editnode_interface');
		     Tk->break;
		   }]
	      ]},
    enable_callback => [ sub {
			   my ($win,$base_path,$node,$path)=@_;
			   return doEvalHook($win,'enable_attr_hook',$path,"normal",$node) eq 'stop' ? 0 : 1
			 }, $win,$attr_path,$node ],
    choices_callback => [ sub {
			   my ($win,$base_path,$node,$path,$mtype,$editor)=@_;
			   return doEvalHook($win,'attr_choices_hook',$path,$node,$mtype,$editor);
			 }, $win,$attr_path,$node ],
    validate_callback => [ sub {
			   my ($win,$base_path,$node,$txt,$path,$mtype,$editor)=@_;
			   my $res = doEvalHook($win,'attr_validate_hook',$txt,$path,$node,$mtype,$editor);
			   defined $res ? $res : 1;
			 }, $win,$attr_path,$node ],
    attribute_sort_callback => [ sub {
				   my ($win,$node,$array,$path)=@_;
				   return doEvalHook($win,'sort_attrs_hook',$array,$path,$node);
				 }, $win,$node ],
    value_sort_callback => [ sub {
					 my ($win,$node,$array,$path)=@_;
					 return doEvalHook($win,'sort_attr_values_hook',$array,$path,$node);
				       }, $win,$node ],
    search_field => length $attr_path ? 0 : 1,
    knit_support => 1,
    validate_flags => PML_VALIDATE_NO_CHILDNODES,
    set_command => sub {
      my ($callback)=@_;
      $win->{FSFile}->notSaved(1) if $win->{FSFile};
      save_undo($win,prepare_undo($win,$dlg_title,UNDO_DATA,$node));
      lastActionBookmark($win->{framegroup});
      &$callback();
      if (length $attr_path) {
	doEvalHook($win,"after_edit_attr_hook",$node,$attr_path,1);
      } else {
	doEvalHook($win,"after_edit_node_hook",$node,1);
      }
    }
   });
  if ($result) {
    get_nodes_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
    redraw_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
  } else {
    if ($attr_path eq EMPTY) {
      doEvalHook($win,"after_edit_node_hook",$node,0);
    } else {
      doEvalHook($win,"after_edit_attr_hook",$node,$attr_path,0);
    }
  }
  return $result;
}

sub editAttrsDialog {
  my ($win,$node)=@_;
  return if (doEvalHook($win,"do_edit_node_hook",$node) eq 'stop');
  return unless $win->{FSFile};
  return editAttrsDialog_schema($win,$node)
    if (ref($node->type) or
	ref(fileSchema($win->{FSFile})));
  my @vals;
  my %e=();
  my @atord=$win->{FSFile}->FS->attributes;

  if ($sortAttrs) {
    @atord=sort {uc($a) cmp uc($b)} $win->{FSFile}->FS->attributes
      unless (doEvalHook($win,"sort_attrs_hook",\@atord,'',$node));
  }
  my $rows=min($maxDisplayedAttributes,$#atord+1);
  my ($a,$b,$r);

  my $enabled=(doEvalHook($win,'enable_edit_node_hook',$node) eq 'stop') ? 0 : 1;
  my @buttons = $enabled ? qw(OK Help Cancel) : ('Cancel');
  $win->toplevel->Busy(-recurse=>1);
  my $d=$win->toplevel->DialogBox(-title=> "Edit Node", -width=> '10c',
				  -buttons=> \@buttons
				 );
  $d->Subwidget('B_Help')->configure(
    -command => 
      [sub {
	 help_topic(shift,'old_editnode_interface');
	 Tk->break;
       },$d]) if $enabled;
  $d->BindButtons;
  $d->BindReturn($d,1);
  $d->BindEscape();
  my $ff=$d->Frame(-relief=> 'groove',
		   -bd => 1);
  my $f= $ff->Scrolled('Pane',
		      -sticky => 'we',
		      -scrollbars=> 'oe');
  disable_scrollbar_focus($f);
  $f->BindMouseWheelVert(EMPTY,"EditEntry");

  my $lwidth;
  foreach (@atord) {
    $lwidth=max2($lwidth,length($_));
  }
  my $height=0;


  for (my $i=0;$i<=$#atord;$i++) {
    $_=$atord[$i];
    # Reliefs: raised, sunken, flat, ridge, and groove.
    my $eef=$f->Frame()->pack(qw/-side top -expand yes -fill x/);
    $eef->Label(-text=> $_,
		-underline => 0,
		-justify => 'left',
		-width =>$lwidth,
		-anchor=> 'nw')->pack(qw/-side left/);

    if  ($win->{FSFile}->FS->isList($_) or
	 $node->get_member($_)=~/^(?:[^\|\\]|\\.)*\|/) { # readonly entry and buttons for list
      $r= $eef->Frame();
      $e{$_}= $r->Entry(-relief=> 'sunken', -takefocus=> 1,
			 -font=> $font)->pack(qw/-expand yes -fill both -side left/);
      addBindTags($e{$_},"EditEntry");
	$b=$r->Button(-text=> "...", -takefocus=> 0,
 		      -command=> [sub {
 				     my ($e,$win,$node,$attr,$d)=@_;
 				     my $result=
 				       ($win->{FSFile}->FS->isList($attr)
 					? editListAttr($win,$e->get,$attr,$d,$node)
 					: editAmbiguousAttr($win,$e->get,$attr,$d));
 				     if (defined $result) {
 				       $e->configure(-state=> 'normal');
 				       $e->delete(0,length($e->get));
 				       $e->insert(0,$result);
 				       $e->configure(-state=> 'disabled');
 				     }
				   },$e{$_},$win,$node,$_,$d]
		     )->pack(qw/-side right/);
	$e{$_}->bind($e{$_},'<space>',[sub { shift; shift->invoke; Tk->break; },$b]);
	$e{$_}->bind($e{$_},'<Return>',[sub { shift; shift->invoke; Tk->break; },$b]);
        $d->BindReturn($e{$_});
	$e{$_}->bind($e{$_},'<Double-ButtonPress-1>',[sub { shift; shift->invoke; Tk->break; },$b]);
      $e{$_}->insert(0,encode($node->get_member($_)));
      $e{$_}->configure(-state=> 'disabled');
      $r->pack(qw/-side right -expand yes -fill both/);
      $height += max2($b->reqheight,$e{$_}->reqheight()) if ($i<$rows);
    } else {
      $e{$_}= $eef->Entry(-relief=> 'sunken', -takefocus=> 1,
			 -font=> $font)->pack(qw/-side right -expand yes -fill both/);
      addBindTags($e{$_},"EditEntry");
      $e{$_}->insert(0,encode($node->get_member($_)));
      if (doEvalHook($win,'enable_attr_hook',$_,"normal") eq 'stop') {
	$e{$_}->configure(-state=> 'disabled');
      }
      $height += $e{$_}->reqheight() if ($i<$rows);
    }
    $f->bind($e{$_}, '<Tab>',       [\&focusxEditDn,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Down>',      [\&focusxEditDn,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Shift-Tab>', [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Shift-ISO_Left_Tab>',
	                            [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Up>',        [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Alt-KeyPress>', [\&focusxFind,$i,\%e,$f,\@atord]);
  }

  $f->configure(-height => $height);
  $f->pack(qw/-expand yes -fill both/);
  $ff->pack(qw/-expand yes -fill both/);
  $win->toplevel->Unbusy();

  my $result= ShowDialog($d,(
			     $atord[0] ? $e{$atord[0]}->focus : undef
			    ),$win->toplevel);

  if ($result=~ /OK/) {
    $win->{FSFile}->notSaved(1);
    save_undo($win,prepare_undo($win,'Edit Node',UNDO_DATA,$node));
    lastActionBookmark($win->{framegroup});
    foreach $a (@atord) {
      $node->set_member($a,decode($e{$a}->get));
    }
    doEvalHook($win,"after_edit_node_hook",$node,1);
    get_nodes_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
    redraw_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
  } else {
     doEvalHook($win,"after_edit_node_hook",$node,0);
  }

  undef %e;
  $d->destroy;
  return ($result =~ /OK/) ? 1 : 0;
}

sub disable_scrollbar_focus {
  my ($scrolled)=@_;
  $scrolled->Subwidget('xscrollbar')->configure(qw(-takefocus 0));
  $scrolled->Subwidget('yscrollbar')->configure(qw(-takefocus 0));
}


sub showMacrosAsHtml {
  my ($grp,$flags,$order_by)=@_;
  my $context = $grp->{selectedContext};
  use File::Temp;
  my $dir = File::Temp::tempdir( CLEANUP => 1 );
  eval {
    Treex::PML::IO::copy_uri(File::Spec->catfile($libDir,'misc','sorttable.js'),
			File::Spec->catfile($dir,'sorttable.js'));
  };
  warn $@ if $@;
  my $html_file = File::Spec->catfile($dir,"$context.html");
  open(my $html, '>:utf8',$html_file)
    or do {
      errorMessage($grp->{top},
		   "Cannot open temporary file $html_file.");
      return 0;
    };
  my $title = "Annotation Mode $context";
  $title.=" + TredMacro" if ($flags&2);
  print $html "<html>\n";
  print $html "<head>\n";
  print $html "  <title>$title</title>\n";
  print $html "  <meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\" />\n";
  print $html "<script src=\"sorttable.js\"></script>\n";
  print $html "</head>\n";
  print $html "<body>\n";
  print $html "<h2>TrEd Macro Reference</h2>\n";
  print $html "<h3>$title</h3>\n";
  print $html "<table class=\"sortable\" preserve_style=\"row\">\n";
  print $html "<thead><tr><th>Keyboard Shortcut</th>";
  print $html "<th>Perl Function</th>" if ($flags&1);
  print $html "<th>Description</th></tr></thead>\n";
  print $html "<tbody>\n";
  my $odd = 0;
  foreach my $entry (generateSortedMacroTable($grp,$context,$flags,$order_by||'N')) {
    my ($name, $key, $macro)=@$entry;
    $name=~s/^_+//;
    print $html "  <tr ",($odd ? 'bgcolor="#ffffff"' : 'bgcolor="#eeeeee"'),
      ">\n    <td>$key</td>\n",
	(($flags&1) ? "<td>$macro</td>\n" : EMPTY),
	  "<td>$name</td>\n",
	    "  </tr>\n";
    $odd = !$odd;
  }
  print $html "</tbody>\n";
  print $html "</table>\n";
  print $html "</body>\n";
  print $html "</html>\n";
  close ($html);
  open_url_in_browser($html_file);
}


sub help_topic {
  my ($top,$section) = @_;
  my $file = $TrEd::Help::HELP_MAP{$section};
  if (defined $file) {
    open_url_in_browser($docDir.'/'.$file."#".$section);
  } else {
    plainErrorMessage($top,"Cannot map '$section' to a documentation page.");
  }
}

sub open_url_in_browser {
  my $url = shift;
  if ( $htmlBrowser eq 'DO_NOT_RUN') {
  } elsif ($^O eq 'MSWin32' and 
	   eval { require ActiveState::Browser; 1 }) {
    print STDERR "ActiveState::Browser::open '$url'\n" if $tredDebug;
    ActiveState::Browser::open("$url");
  } elsif ( $htmlBrowser ne EMPTY) {
    $htmlBrowser.=" %u" unless ($htmlBrowser =~ /\%[uf1]/);
    my $cmd = $htmlBrowser;
    $cmd =~ s/\%1/$url/g;
    $cmd =~ s/\%[fu]\b/"$url"/g;
    print STDERR "$cmd\n" if $tredDebug;
    if ($^O eq 'MSWin32') {
      $cmd = 'start '.$cmd unless $cmd=~/^\s*start\s/;
      if ($cmd=~/iexplore.exe/i) {
	$cmd=~s/ -nohome//g;
	$cmd='start /B '.$cmd;
      }
      return system($cmd);
    } else {
      return system $cmd.' &';
    }
  } else {
    if ($^O eq 'MSWin32') {
      my $browser_key = fetch_from_win32_reg('HKEY_LOCAL_MACHINE',
					     q(SOFTWARE\Classes\.html));
      if ($browser_key ne EMPTY) {
 	$htmlBrowser = fetch_from_win32_reg('HKEY_LOCAL_MACHINE',
					    q(SOFTWARE\Classes\\).
					    $browser_key.
					    q(\shell\open\command));
      }
      unless ($htmlBrowser ne EMPTY) {
	warn "Could not determine default browser.\n".
	  "Contextual help may not jump to the correct paragraph.";
	$htmlBrowser='start /B "%1"';
      }
    }
    elsif ($^O eq 'darwin') {
      $htmlBrowser='open %u';
    }
    elsif ($ENV{DESKTOP_LAUNCH} ne EMPTY) {
      $htmlBrowser=$ENV{DESKTOP_LAUNCH};
    }
    elsif (which('xdg-open') ne EMPTY) {
      $htmlBrowser='xdg-open %u';
    }
    # Otherwise we emulate xdg-open
    # detect KDE
    elsif ($ENV{KDE_FULL_SESSION} eq "true") {
      if (which('kde-open') ne EMPTY) {
	$htmlBrowser='kde-open %u';
      } else {
	$htmlBrowser='kfmclient openURL %u';
      }
    } # detect GNOME
    elsif ($ENV{GNOME_DESKTOP_SESSION_ID} ne EMPTY and
	   which('gnome-open') ne EMPTY) {
      $htmlBrowser='gnome-open %u';
    } # generic
    elsif ($ENV{BROWSER} ne EMPTY and which($ENV{BROWSER}) ne EMPTY) {
      $htmlBrowser=$ENV{BROWSER};
    }
    elsif ($htmlBrowser = first {which($_) ne EMPTY}
	     qw(firefox mozilla netscape opera htmlview)) {
      # already assigned
    } else {
      warn "Did not find any HTML browser.\nPlease set the 'htmlbrowser' configuration option or either of DESKTOP_LAUNCH or BROWSER environment variables.";
      $htmlBrowser='DO_NOT_RUN';
      return undef;
    }
    return open_url_in_browser($url);
  }
}

sub format_tred_pod {
  map {
    if (/^([HUBICQ])<(.[^>]*)>/) {
      my $style;
      if ($1 eq 'B') {
	$style = 'bold';
      } elsif ($1 eq 'I') {
	$style = 'italic';
      } elsif ($1 eq 'C') {
	$style = 'fixed';
      } elsif ($1 eq 'U') {
	$style = 'underlined';
      } elsif ($1 eq 'H') {
	$style = 'heading';
      } else {
	$style = 'default';
      }
      my $l = $2;
      $l=~s/&lt;/\</g;
      $l=~s/&gt;/\>/g;
      ($l,$style)
    } elsif (/^L<(.[^>]*)>/) {
      my $l = $1;
      $l=~s/&lt;/\</g;
      $l=~s/&gt;/\>/g;
      my ($t,$sec)=split /#/,$l,2;
      ($t,['link','#'.$sec])
    } else {
      my $l=$_;
      $l=~s/&lt;/\</g;
      $l=~s/&gt;/\>/g;
      ($l,'default')
    }} split /([HUBILCQ]<.[^>]*>)/,$_[0]
}

sub tred_pod_add_tags {
  my ($grp,$w)=@_;
  $w->tag(qw(configure link -font C_default -foreground blue));
  $w->tag(qw(configure link_hover -underline 1));

  $w->tagBind('link', '<Any-Enter>' =>
		sub {
		  my $w = shift;
		  my $idx = $w->index($w->XEvent->xy);
		  my ($start,$end) = $w->tagPrevrange('link',$idx);
		  if ($start eq EMPTY) {
		    ($start,$end) = $w->tagNextrange('link',$idx);
		  }
		  if ($start ne EMPTY) {
		    $w->tagAdd('link_hover', $start,$end);
		  }
		}
	     );
  $w->tagBind('link_hover', '<Any-Leave>' =>
		sub {
		  shift->tagRemove('link_hover','0.0','end')
		}
	     );
  $w->tagBind(qw(link <1>) => sub {
		my $w = shift;
		my $Ev = $w->XEvent;
		my $idx = $w->index($Ev->xy);
		if ($idx ne EMPTY) {
		  my $sect = first {/^#/} $w->tagNames($idx);
		  if ($sect) {
		    $sect =~ s/^#//;
		    $w->toplevel->Deactivate;
		    help_topic($w,$sect);
		  }
	        }
	      }
	     );

  $w->tag(qw(configure underlined -font C_default -underline 1));
  $w->tag(qw(configure heading -font C_heading));
  $w->tag(qw(configure bold -font C_bold));
  $w->tag(qw(configure fixed -font C_fixed));
  $w->tag(qw(configure default -font C_default));
  $w->tag(qw(configure italic -font C_italic));
}


sub _sytylesheetInsertAttr {
  my ($e,$name,$using_this) = @_;
  my @tags = $e->tagNames('insert');
  
  # work around ends of lines where no tags appear
  # look one char back and if we are not after an end-of-code ?>, we take the tags from there

  my $startline = length($e->get('insert linestart','insert'))==0 ? 1 : 0;
  my $endline = length($e->get('insert','insert lineend'))==0 ? 1 : 0;
  my @one_before_idx = ('insert - '.(1+$startline).' chars','insert'.($startline ? ' - 1 chars' : ''));
  my @two_before_idx = ('insert - '.(2+$startline).' chars','insert'.($startline ? ' - 1 chars' : ''));
  my @one_after_idx =  ('insert'.($endline ? ' + 1 chars' : ''),'insert + '.(1+$endline).' chars');

  my $before = 0;
  if (!@tags and !($e->get(@two_before_idx) eq '?>' and
	first { $_ eq 'Code' } $e->tagNames(@one_before_idx[0]))) {
    @tags = $e->tagNames(@one_before_idx[0]);
  }
    
  my $str;
  if ( first { /^(?:Code|CAttribute|Variable)$/ } @tags ) {
    $str= $using_this ? q{$this->attr('}.$name.q{')} : '$${'.$name.'}';
    if (  first { /^(?:CAttribute|Variable|QString|String)$/ } $e->tagNames(@one_before_idx[0]) ) {
      $str = '.'.$str;
    }
    if (  first { /^(?:CAttribute|Variable|QString|String)$/ } $e->tagNames(@one_after_idx[0]) ) {
      $str .= '.';
    }
  } elsif  ( first {/^(?:QString|QAttribute|QStyle)$/} @tags ) {
    $str= $using_this ? q{".$this->attr('}.$name.q{')."} : '\\${'.$name.'}' ;
  } else {
    $str='${'.$name.'}';    
  }
  $e->Insert($str);    

  # Insert should be equivalent to previously used
  #  $e->delete('sel.first','sel.last') 
  #    if ($e->tagNextrange('sel','0.0'));
  #  $e->insert('insert',$str);
}

sub editStylesheetDialog {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  return if (doEvalHook($win,"customize_attrs_hook") eq 'stop');

  return unless $win->treeView->patterns() or $win->{FSFile};

  $grp->{top}->Busy(-recurse=>1);
  my @buttons = ("OK", ($win->{FSFile} ? "Preview" : ()),
	    (($win->{FSFile} and $win->{stylesheet} ne STYLESHEET_FROM_FILE()) ? "Store to current file" : ()),
		 "Cancel");
  my $d=$grp->{top}->
    DialogBox(-title=> "Stylesheet editor",
	      -width=> '10c',
	      -buttons=> \@buttons);

  $d->Subwidget("B_$_")->configure(-underline => 0) for @buttons;
  $d->Subwidget('top')->configure(qw(-takefocus 0));
  $d->Subwidget('bottom')->configure(qw(-takefocus 0));

  # Pattern Editor
  my $eff=$d->Frame(qw/-relief sunken -bd 1 -takefocus 0/)->
    pack(qw/-padx 3 -pady 3 -side top -fill x/);
#  $eff->Frame(qw/-height 6 -takefocus 0/)->pack();
  my $elabff=$d->Frame->pack(-in => $eff, qw/-padx 3 -pady 3 -side top -fill x/);

  # will be used later
  my @text_opt = 
   eval { require Tk::CodeText; require Tk::CodeText::TrEdStylesheet }
     ? (qw(CodeText -syntax TrEdStylesheet), -indentchar => '  ')
 : eval { require Tk::TextUndo }
   ? qw(TextUndo)
 : qw(Text);

  $elabff->Label(-text => "Here you can edit the current display stylesheet (press ^I to insert tab, ^L to clear"
		   .($text_opt[0] eq 'CodeText' ? ", ^Z to undo" : EMPTY).")     ",
		 -anchor => 'nw', -justify => 'left')->pack(qw/-side left/);
  my $helplabel = $elabff->Label(-text => "Help",
			    -underline => 0,
			    -anchor => 'nw', -justify => 'left')
    ->pack(qw/-side right/);

  my $HELP = <<'EOF';
H<Stylesheet quick help>

I<This dialog allows you to edit the current display stylesheet.>

I<A stylesheet consists of PATTERNS (as described below) which influence the overall tree appearance as well as visual representation of individual nodes, edges and labels (including label content).>

I<A pattern can represent one line of a label of a node or an edge, define a per-node text to appear in the text line above the tree, and/or provide styling information for the node and its edges, e.g. the shape, color, line thickness, line style, etc.>

I<See the >L<User's manual#stylesheets>I< for more details.>

H<Pattern syntax>

B<PATTERN:> C<&lt;prefix&gt;:&lt;rules&gt;>

B<Default prefixes:>
  C<context    >- restrict stylesheet to contexts matching given regexp
  C<node       >- define a node label (default if no prefix given)
  C<edge       >- define an edge label
  C<style      >- define node and edge appearance (for individual nodes)
  C<rootstyle  >- define node and edge appearance globally
  C<text       >- define per-node value-line text
  C<hint       >- renders to text displayed in a node's tooltip

B<Rules interpolation:>
  C<${attribute}    >- interpolates to the attribute value
  C<#{color}        >- applies given font color to the rest of the label

  C<&lt;? perlcode ?&gt;>  - evaluates Perl code and interpolates the result.
                    C<$this> - the node the label or style applies to
                    C<$root> - root of the tree
                    C<$${attribute}> - like C<"$this-&gt;{attribute}">

  any other text - interpolates to itself

H<Root Styles>

B<SYNTAX:>  C<#{name:value}> or C<#{name}>


  C<balance             >- #{balance:1} draws a balanced rather than ordered tree;
  C<                    >  #{balance:spread} is the same but projective on leafs (useful e.g. for Penn Treebank)
  C<vertical            >- draw the tree L<vertically#vertical-mode>
  C<baseXPos            >- X-coordinate of the root node
  C<baseYPos            >- Y-coordinate of the root node
  C<nodeXSkip           >- default horizontal skip between nodes
  C<nodeYSkip           >- default vertical skip between nodes
  C<lineSpacing         >- line-spacing coeficient in text labels (Default: 1)
  C<skipHiddenParents   >- connect nodes with hidden parents to nearest
  C<                    >  displayed ancestors
  C<skipHiddenLevels    >- display nodes with hidden parents one level below their nearest
  C<                    >  displayed ancestors (implies C<skipHiddenParents>)
  C<labelsep            >- space between node and label in vertical mode
  C<columnsep           >- space between columns in vertical mode
  C<columnsep[i]        >- space before i-th column in vertical mode
  C<stackOrder          >- comma separated list of item tags defining a z-axis
                           ordering of canvas items (lowest first)

H<Styles>

B<SYNTAX:>  C<#{object-feature:value}>

B<Object features> (by category)

U<Hiding nodes>
  C<Node-hide           >- if non-zero, do not display the node at all
  See also C<skipHiddenParents> and C<skipHiddenLevels> rootstyles.

U<Shape>
  C<Node-shape          >- oval, rectangle, polygon
  C<Node-polygon        >- relative coordinates of the poligon points

U<Colors>
  Colors can be specified either by name (such as 'red', 'lightblue', etc.), or
  by a hex RGB string of the form #RRGGBB.

  C<Oval-fill           >- color to fill a node shape with
  C<Oval-outline        >- color of the outline of node shape
  C<CurrentOval-fill    >- color to fill the shape of an active node with
  C<CurrentOval-outline >- color of the outline of the shape of the active node
  C<Line-fill           >- color of the edge (see U<Edges>)

  C<Oval-dash           >- pattern for the outline of the node shape
  C<                    >  (oval/rectangle/polygon)
  C<CurrentOval-dash    >- pattern for the outline of the active node shape
  C<Oval-dashoffset     >- starting offset for the outline pattern

U<Size>
  C<Node-width          >- set shape width to the given amount
  C<Node-height         >- set shape height to the given amount
  C<Oval-width          >- width of the outline of a node shape
  C<CurrentOval-width   >- width of the outline of an active node shape
  C<Node-addwidth       >- add to shape width by given amount
  C<Node-addheight      >- add to shape height by given amount
  C<Node-currentwidth   >- set shape width for active node
  C<Node-currentheight  >- set shape height for active node

U<Position and level>
  C<Node-addbeforeskip  >- skip before: 10, 2c, 12pt, etc.
  C<Node-addafterskip   >- skip after
  C<Node-rellevel       >- alter vertical leveling of the subtree
  C<Node-level          >- alter vertical leveling of a single node
  C<NodeLabel-skipempty >- skip empty node labels
  C<EdgeLabel-skipempty >- skip empty edge labels
  C<NodeLabel-yadj      >- adjust vertical position of node labels by given amount
  C<EdgeLabel-yadj      >- adjust vertical position of edge labels by given amount
  C<EdgeLabel-coords    >- custom edge label position. Default: (n+p)/2,(n+p)/2

U<Alignment>
  C<Node-textalign      >- alignment of labels within label-box (right,left,center)
  C<Node-textalign[i]   >- alignment of i-th label within label-box (right,left,center)
  C<NodeLabel-valign    >- only as rootstyle. Values: top, center, bottom.
  C<NodeLabel-halign    >- left, right, center
  C<Edge-textalign      >- alignment of edge labels within label-box (right,left,center)
  C<EdgeLabel-halign    >- values: right, center, left
  C<EdgeLabel-valign    >- values: top, center, bottom

U<Edges (lines)>
  C<Line-coords         >- coordinations of the edge(s) to be drawn.
  C<                    >  Default: n,n,p,p (see the L<documentation#Line-coords>)
  C<                    >  May consist of more &-separated segments.
  C<Line-arrow          >- side of an edge to put an arrow on: first, both, last
  C<Line-smooth         >- 1 if the line should be drawn as a curve, 0 otherwise.
  C<Line-tag            >- tags passed to line_click_hook (see the L<documentation#Line-tag>)
  C<Line-hint           >- text to show when pointer hovers over the line (see the L<documentation#Line-hint>)
  C<Line-...            >- where C<...> is any of C<dash>, C<activedash>, C<dashoffset>,
  C<                    >  C<fill>, C<activefill>, C<width>, and C<activewidth>
  C<                    >  specifying visual properties of edges. Values and
  C<                    >  semantics are similar to those of C<Oval-...>.
  C<                    >  Values for individual line segments are &-separated.

U<Boxes around labels>
  C<NodeLabel-dodrawbox >- force drawing a box around labels: (yes,no)
  C<NodeLabel-nodrawbox >- force disabling a box around node label: (yes,no)
  C<EdgeLabel-dodrawbox >- force drawing a box around edge labels: (yes,no)
  C<EdgeLabel-nodrawbox >- force disabling a box around node label: (yes,no)
  C<TextBox-...         >- where C<...> is any of C<dash>, C<activedash>,
  C<                    >  C<dashoffset>, C<fill>, C<activefill>, C<outline>, 
  C<                    >  C<activeoutline>, <width>, C<activewidth>
  C<                    >  (see the L<documentation#TextBox> for details)
  C<EdgeTextBox-...     >- similar, see the L<documentation#EdgeTextBox>
  C<CurrentTextBox-...  >- options specific for Text Box of the current node
  C<CurrentEdgeTextBox..>- options specific for Edge Box of the current node
  C<Text[...]-..        >- see the L<documentation#Textposition-fill>
  C<TextBg[...]-..      >- see the L<documentation#TextBg>
EOF

  require Tk::HelpTiptool;
  my $help = $d->HelpTiptool(-background => '#ffffbb',
			     -troughcolor => '#cccc99',
			     -message=> [format_tred_pod($HELP)]
			    );
  tred_pod_add_tags($grp,$help->Subwidget('text'));
  $d->bind('<Alt-h>', sub { $help->Toggle($helplabel); });
  $help->bind('<Alt-h>', sub { $help->Toggle($helplabel); });

  $helplabel->bind('<Button>', sub { $help->Toggle($helplabel); });
  # All wrapping frame with attribute selection and buttons
  my $f= $d->Frame(qw/-relief sunken -bd 1 -takefocus 0/);
#  $f->Frame(qw/-height 6 -takefocus 0/)->pack(qw/-side bottom/);
  # Frame with pattenrs listbox
  my $cf= $f->Frame(qw(-takefocus 0));

  # @text_opt defined few paragraphs above
  my $e= $cf->Scrolled(@text_opt, 
		       qw/-scrollbars osoe -height 35
			  -relief sunken -borderwidth 2/);
  my $edit = $e->Subwidget('scrolled');
  _deleteMenu($edit->menu,'File');
  if ($text_opt[0] eq 'CodeText') {
    $edit->bindtags([$edit,ref($edit),$edit->toplevel,'all']);
    $edit->bind('<Tab>', sub { shift->focusNext; Tk->break });
    my $syntax = $edit->menu->entrycget('View','-menu')->entrycget('Syntax','-menu');
    my $last = $syntax->index('last');
    if ($last ne 'none') {
      $syntax->delete($_) for grep { defined and !/^(None|Perl|TrEdStylesheet)$/ }
	map { eval { local $SIG{__DIE__}; $syntax->entrycget($_,'-label')} } 0..$last
    }
    $edit->menu->entrycget('View','-menu')->delete('Rules Editor');
  }

  disable_scrollbar_focus($e);

  my $preview_applied;
  # the preview command
  if ($d->Subwidget('B_Preview')) {
    $d->Subwidget('B_Preview')->configure(
      -command => [sub {
		     my ($win,$e,$p)=@_;
		     $$p = 1;
		     my ($hint,$context,$patterns)=getStylesheetPatterns($win);
		     setStylesheetPatterns($win,$e->get('0.0','end'));
		     update_value_line($grp);
		     if ($win->{stylesheet} eq STYLESHEET_FROM_FILE()) {
		       get_nodes_fsfile($grp,$win->{FSFile});
		       redraw_fsfile($grp,$win->{FSFile});
		     } else {
		       get_nodes_stylesheet($grp,$win->{stylesheet});
		       redraw_stylesheet($grp,$win->{stylesheet});
		     }
		     setStylesheetPatterns($win,[$hint,$context,$patterns]);
		   },$win,$e,\$preview_applied]);
  }
  # Frame with attribute selection
  my $af;
  my @atord=();
  my $attrs = doEvalHook($win,"get_node_attrs_hook",'edit_stylesheet');
  if (ref($attrs)) {
    @atord=@$attrs;
  } else {
    if ($win->{FSFile}) {
      if (fileSchema($win->{FSFile})) {
	@atord = fileSchema($win->{FSFile})->attributes;
      } else {
	@atord = $win->{FSFile}->FS->attributes;
      }
    }
    if ($sortAttrs) {
      @atord=sort {uc($a) cmp uc($b)} @atord
	unless (doEvalHook($win,"sort_attrs_hook",\@atord,'',undef));
    }
  }

  if (@atord) {
    $af = $f->Frame(qw(-takefocus 0));
    #  $af->Frame(qw/-height 15 -takefocus 0/)->pack();
    # Attributes listbox
    $af->Label(qw/-text Attributes -underline 0 -anchor nw -justify left/)->pack(qw/-fill both/);
    my $al= $af->Scrolled(qw/Listbox
			     -bg white
			     -width 0
			     -relief sunken
			     -borderwidth 2 -setgrid true
			     -scrollbars oe
			     -exportselection 0/)->pack(qw/-pady 3 -expand yes -fill y/);
    $d->bind('<Alt-a>', [$al,'focus']);
    disable_scrollbar_focus($al);
    $al->BindMouseWheelVert();
    
    $al->insert('end',@atord);
    if (@atord) {
      $al->activate(0);
      $al->selectionSet(0);
    }
    
    $af->pack(qw/-padx 5 -side left -fill y/) if $af;
    $al->bind('<Double-1>'=>
		[sub {
		   _sytylesheetInsertAttr($e,$al->get('active'));
		   $e->focus();
		   Tk->break;
		 }]
	       );
    $al->bind('<Shift-Double-1>'=>
		[sub {
		   _sytylesheetInsertAttr($e,$al->get('active'),1);
		   $e->focus();
		   Tk->break;
		 }]
	       );
    $al->bind('<space>'=>
		[sub {
		   _sytylesheetInsertAttr($e,$al->get('active'));
		   Tk->break;
		 }]
	       );
    $al->bind('<Return>'=>
		[sub {
		   _sytylesheetInsertAttr($e,$al->get('active'));
		   $e->focus();
		   Tk->break;
		 }]
	       );
  }

  {
    my $patterns=getStylesheetPatterns($win);
    chomp $patterns;
    $e->insert('0.0',$patterns."\n");
  }
  $e->pack(qw/-padx 3 -pady 3 -side top -expand yes -fill both/);
  $e->TextSearchLine(-parent => $cf,-label=>'S~earch',
		     -prev_img =>icon($grp,'16x16/up'),
		     -next_img =>icon($grp,'16x16/down'),
		    )->pack(qw(-fill x -side bottom));

  $cf->pack(qw/-padx 5 -side left -expand yes -fill both/);


  $f->pack(qw/-padx 3 -pady 3 -side top -expand yes -fill both/);

#   $d->bind('all','<Tab>',['focusNext']);
#   $edit->bindtags([$edit,ref($edit),$edit->toplevel,'all']);
#   $edit->bind('<Control-l>',sub {$_[0]->delete('0.0','end'); Tk->break; });
#   $edit->bind('<Tab>',sub { shift->focusNext; Tk->break });
#   $d->bind('all','<Shift-Tab>',sub { shift->focusPrev; Tk->break });
#   $d->bind('all','<Shift-ISO_Left_Tab>',sub { shift->focusPrev; Tk->break });
#   $edit->bind('<Return>',sub{ shift->Insert("\n"); Tk->break; });
#   $edit->bind(ref($edit),'<Control-Return>','NoOp');
#   $d->bind($edit,'<Control-Return>','NoOp');
#   $d->bind('all','<Escape>'=> [sub{ 
# 				 my ($w,$dlg,$hlp)=@_;
# 				 if ($hlp->isActive) {
# 				   $hlp->Deactivate();
# 				 } else {
# 				   $dlg->BindEscape($w);
# 				 }
# 			       },$d,$help]);
  $d->bind($d,'<Tab>',['focusNext']);
  $edit->bindtags([$edit,ref($edit),$edit->toplevel,'all']);
  $edit->bind('<Control-l>',sub {$_[0]->delete('0.0','end'); Tk->break; });
  $edit->bind('<Tab>',sub { shift->focusNext; Tk->break });
  $d->bind($d,'<Shift-Tab>',sub { shift->focusPrev; Tk->break });
  $d->bind($d,'<Shift-ISO_Left_Tab>',sub { shift->focusPrev; Tk->break });
  $edit->bind('<Return>',sub{ shift->Insert("\n"); Tk->break; });
  $edit->bind(ref($edit),'<Control-Return>','NoOp');
  $d->bind($edit,'<Control-Return>','NoOp');
  $d->bind('<Escape>'=> [sub{ 
			   my ($w,$dlg,$hlp)=@_;
			   if ($hlp->isActive) {
			     $hlp->Deactivate();
			   } else {
			     $dlg->afterIdle(sub{ $dlg->{selected_button} = 'Cancel' });
			   }
			   Tk->break;
			 },$d,$help]);
  $d->BindReturn();
  $d->protocol('WM_DELETE_WINDOW' => [sub { $_[0]->{selected_button} = 'Cancel' }, $d]);
  $d->BindButtons;
  $e->focus();
  $grp->{top}->Unbusy();
  my $result= ShowDialog($d,$e,$grp->{top});
  if ($result eq 'Store to current file') {
    switchStylesheet($grp,STYLESHEET_FROM_FILE());
    $grp->{selectedStylesheet} = STYLESHEET_FROM_FILE();
    $win->{FSFile}->notSaved(1);
    $result = 'OK';
  }
  if ($result=~ /OK/) {
    setStylesheetPatterns($win,$e->get('0.0','end'));
    updateStylesheetMenu($grp);
    if ($win->{stylesheet} eq STYLESHEET_FROM_FILE()) {
      $win->{FSFile}->notSaved(1);
    } else {
      saveStyleSheetFile($grp,$defaultStylesheetPath,$win->{stylesheet});
    }
    get_nodes_fsfile($grp,$win->{FSFile});
    update_value_line($grp);
    if ($win->{stylesheet} eq STYLESHEET_FROM_FILE()) {
      redraw_fsfile($grp,$win->{FSFile});
    } else {
      redraw_stylesheet($grp,$win->{stylesheet});
    }
  } elsif ($preview_applied) {
    get_nodes_fsfile($grp,$win->{FSFile});
    if ($win->{stylesheet} eq STYLESHEET_FROM_FILE()) {
      redraw_fsfile($grp,$win->{FSFile});
    } else {
      redraw_stylesheet($grp,$win->{stylesheet});
    }
  }
  $d->destroy;
  undef $d;
}


#####################################################
#####################################################
#####################################################
# Node searching
#####################################################

sub findNodeDialog {
  my ($grp,$template)=@_;
  return unless $grp->{focusedWindow}->{FSFile};
  my $win = $grp->{focusedWindow};
  my $r;
  my @vals;
  my @atord;
  if (fileSchema($win->{FSFile})) {
    @atord = fileSchema($win->{FSFile})->attributes;
  } else {
    @atord = $win->{FSFile}->FS->attributes;
  }

  if ($sortAttrs) {
    my @atord2 = @atord;
    if (doEvalHook($win,"sort_attrs_hook",\@atord2,'',undef)) {
      @atord = @atord2;
    } else {
      @atord=sort {uc($a) cmp uc($b)} @atord
    }
  }

  my $b;
  my $a;
  my $rows=min($maxDisplayedAttributes,$#atord+1);
  my %e=();
  $grp->{top}->Busy(-recurse=>1);
  my $d=$grp->{top}->DialogBox(-title=> "Find Node By Attributes", -width=> '10c',
				 -buttons=> ["Find"]);
  my $bcl=$d->Subwidget('bottom')->Button(-text=> "Clear",
				  -command=> [sub { my $e=shift;
						     foreach (keys %$e) {
						       $e->{$_}->delete(0,'end');
						     }
						   },\%e] );
  my $bca=$d->Subwidget('bottom')->Button(-text=> "Cancel",
				  -command=> [sub { shift->{selected_button}= "Cancel"},$d] );
  foreach ($bcl,$bca) {
    $_->configure(-width=> 10, -pady=> 0) if ($Tk::platform eq 'MSWin32');
    $_->pack(-side=> 'left', -expand=> 1,  -padx=> 1, -pady=> 1);
  }
  $d->BindReturn($d,1);
  $d->BindEscape();
  my $ff=$d->Frame(-relief=> 'groove',
		   -bd => 1);
  my $f= $ff->Scrolled('Pane',
		      -sticky => 'we',
		      -scrollbars=> 'oe');
  disable_scrollbar_focus($f);
  $f->BindMouseWheelVert(EMPTY,"EditEntry");

  my $lwidth;
  foreach (@atord) {
    $lwidth=max2($lwidth,length($_));
  }
  my $height=0;
  for (my $i=0;$i<=$#atord;$i++) {
    $_=$atord[$i];
    # Reliefs: raised, sunken, flat, ridge, and groove.
    my $eef=$f->Frame()->pack(qw/-side top -expand yes -fill x/);
    $eef->Label(-text=> $_,
		-underline => 0,
		-justify => 'left',
		-width =>$lwidth,
		-anchor=> 'nw')->pack(qw/-side left/);
    $e{$_}= $eef->Entry(-relief=> 'sunken', -takefocus=> 1,
			-font=> $font)->pack(qw/-side right -expand yes -fill both/);
    addBindTags($e{$_},"EditEntry");
    $e{$_}->insert(0,encode($template->{$_}));
    $height += $e{$_}->reqheight() if ($i<$rows);
    $f->bind($e{$_}, '<Tab>',       [\&focusxEditDn,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Down>',      [\&focusxEditDn,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Shift-Tab>', [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Shift-ISO_Left_Tab>',
	                            [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Up>',        [\&focusxEditUp,$i,\%e,$f,\@atord]);
    $f->bind($e{$_}, '<Alt-KeyPress>', [\&focusxFind,$i,\%e,$f,\@atord]);
  }
  $f->configure(-height => $height);
  $f->pack(qw/-expand yes -fill both/);
  $ff->pack(qw/-expand yes -fill both/);

  do {
    my $of=$d->Frame()->pack(qw/-expand yes -fill x/);
    $of->Label(-text=> 'Search method: ')->pack(qw/-side left/);
    my $om = $of->Optionmenu(-variable=> \$grp->{templateMatchMethod},
		    -textvariable=> \$grp->{templateMatchMethod},
		    -options=> ['Regular expression',
				'Exhaustive regular expression',
				'Wildcard pattern',
				'Literal'])->pack(qw/-side left/);
    $om->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
    $of->Checkbutton(-text => 'Always load secondary files',
		     -variable => \$grp->{searchAlwaysSecondary})->pack(qw/-side right/);
  };
  my $of=$d->Frame()->pack(qw/-expand yes -fill x/);
  $of->Label(-text=> 'Search file-list: ')->pack(qw/-side left/);
  my $ot = $of->Optionmenu(-variable=> \$grp->{searchFilelistTraverse},
			   -textvariable=> \$grp->{searchFilelistTraverseText},
			   # -textvariable is only used here to preserve last state
			   -options=> [ [ 'Whole files' => 'all' ],
					[ 'Particular tree' => 'tree' ],
					[ 'Particular node' => 'node' ] ]);
  $ot->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  my $oe = $of->Button(-text=> 'Edit');
  my $om=$of->Optionmenu(-textvariable=> \$grp->{searchFilelist},
			 -command => [
			   sub {
			     my $opt = pop;
			     my $state = $opt eq '[Current file only]' ? 'disabled' : 'normal';
			     for my $w (@_) {
			       $w->configure(-state => $state)
			     }
			   },
			   $ot,$oe
			  ]
			)->pack(qw/-side left/);
  $om->menu->bind("<KeyPress>", [\&NavigateMenuByFirstKey,Ev('K')]);
  $om->options(['[Current file only]', map { $_->name } @filelists]);
  $oe->configure(
    -command=> [ sub {
		   my ($grp)=@_;
		   my $name=filelistDialog($grp,1);
		   $om->options(['[Current file only]',sort map { $_->name } @filelists]);
		   $grp->{searchFilelist}=$name if (ref(findFilelist($name)));
		 },$grp,$om]);
  $oe->pack(qw/-side left/);
  $ot->pack(qw/-side left/);
  $grp->{top}->Unbusy();
  $d->BindButtons;
  my $result= ShowDialog($d,($atord[0] ? $e{$atord[0]}->focus : undef),$grp->{top});
  if ($result=~ /Find/) {
#    %$template = (); # cleanup template
    my $search_code = 'sub {
  my ($node)=@_;';
    my $method=substr($grp->{templateMatchMethod},0,1);
    foreach my $t (@atord) {
      my $val = decode($e{$t}->get);
      $searchTemplate{$t}=$val;
      if ($val ne EMPTY) {
	$search_code.='  return 0 unless $node->all(q{'.$t.'});
  for ($node->all(q{'.$t.'})) { return 0 unless ';
	if ($method eq 'E') {
	  my $re = qr{^$val$};
	  $search_code .= '$_ =~ m('.$re.')';
	} elsif ($method eq 'R') {
	  my $re = qr{$val};
	  $search_code .= '$_ =~ m('.$re.')';
	} elsif ($method eq 'W') {
	  $val=~s/([+\[\].^$(){}<>\\])/\\$1/g;
	  $val=~s/\*/.\*/g;
	  $val=~s/\?/./g;
	  my $re = qr{^$val$};
	  $search_code .= '$_ =~ m('.$re.')';
	} else { # $method eq 'L'
	  $val =~ s{([\\'])}{\\$1}g;
	  $search_code .= '$_ eq '."'$val'";
	}
	$search_code .= " }\n";
      }
    }
    $search_code .= '  return 1;'."\n}";
    print STDERR "$search_code\n" if $tredDebug;
    $search_code = eval $search_code;
    $grp->{searchCode}=$search_code;
    if ($@) {
      errorMessage($win,$@);
    } else {
      if ($grp->{searchFilelist} ne '[Current file only]') {
	my $fl=findFilelist($grp->{searchFilelist});
	if (ref($fl) and $fl->file_count>0 ) {
	  local $insideEval=1;                 # no redraw
	  $fl->set_current($fl->file_at(0));
	  selectFilelist($grp,$fl);
	}
      } else {
	$grp->{searchFilelist}=undef;
      }
      doFindFirstTemplated($grp,0);
    }
  }
  $d->destroy;
  undef $d;
}

#####################################
# bound to Escape for busy widgets
#####################################
sub _search_busy {
  my ($w,$grp,$no_break)=@_;
  print STDERR $grp->{focusedWindow}->{currentFileNo}."stopped by user\n" if ($tredDebug);
  $grp->{stopSearch}=1;
  Tk->break unless $no_break;
}

#####################################
# called after file open to process
# event queue and let user interrupt
# the search process
#####################################
sub _quick_update {
  my ($grp,$no_idle)=@_;
  my $g = $grp->{searchGrabWindow};
  my $now = time; #once in a second
  return unless ($now-$grp->{searchGrabWindow_last}>=1);
  $grp->{searchGrabWindow_last}=$now;

  my $win = $grp->{focusedWindow};
  my $f = $win->{FSFile};
  my $current = $win->{currentFileNo}+1;
  my $all = $win->{currentFilelist}->file_count();
  my $fn = $f && filename($f->filename());
  $grp->{searchGrabWindow_status} = "File '$fn'     ( $current / $all )";
  if ($grp->{searchGrabWindow_active}==1) {
    $grp->{searchGrabWindow_active}=2;
    $grp->{searchGrabWindow_last}=0;
    $grp->{top}->Unbusy();
    $g->Popup;
    Tk::catch {
      $g->grab;
    };
    my ($b)=grep { ref($_)=~/Button/ } $g->children;
    $b->focusForce if $b;
    $g->update();
  } elsif ($grp->{searchGrabWindow_active}==2) {
    $g->update();
  }
}

sub _createSearchGrabWindow {
  my ($grp)=@_;
  $grp->{top}->Busy(-recurse=>1);
  if ($grp->{searchFilelist}) {
    $grp->{searchGrabWindow_status}='';
    my $g;
    unless ($grp->{searchGrabWindow}) {
      $g = $grp->{top}->Toplevel(-title=>"Search");
      $g->withdraw();
      $g->Label(-text=>"Search in progress...",-width=>'40')->pack(-pady=>10,-padx=>10);
      $g->Label(-justify=>'left',
		-anchor=>'nw',
		-textvariable=>\$grp->{searchGrabWindow_status})->pack(-pady=>5,-padx=>10,-fill=>'x');
      $g->Button(-text=>'Interrupt',
		 -command => [\&_search_busy,$g,$grp])->pack(-pady=>5,-padx=>10);
      $g->protocol('WM_DELETE_WINDOW' => [\&_search_busy,$g,$grp,0]);
      $g->transient($grp->{top});
      $grp->{searchGrabWindow} = $g;
    }
    $grp->{searchGrabWindow_time}=0;
    $grp->{searchGrabWindow_active} = 1;
  }
}

sub _closeSearchGrabWindow {
  my ($grp)=@_;
  if ($grp->{searchGrabWindow_active}==2) {
    $grp->{searchGrabWindow_active} = undef;
    $grp->{searchGrabWindow_status} = undef;
    my $g = $grp->{searchGrabWindow};
    Tk::catch {
      $g->grabRelease;
    };
    $g->withdraw;
  }
  $grp->{top}->Unbusy();
}

######################################
# start searching for a next node
# and display result unless succeeded
######################################

sub findTemplated {
  my ($grp,$cont,$callback)=@_;
  my $win = $grp->{focusedWindow};
  return undef unless ($win->{currentNode});

  my @save = ($opt_t,$win->{noRedraw},$grp->{noUpdateTitle},$grp->{noUpdatePostponed},
	      $grp->{noRecent},$grp->{noUpdateStylesheetMenu},$grp->{noUpdateMacrolistView},$grp->{noSaveFileStateUpdate});
  ($opt_t,
   $win->{noRedraw},
   $grp->{noUpdateTitle},
   $grp->{noUpdatePostponed},
   $grp->{noRecent},
   $grp->{noUpdateStylesheetMenu},
   $grp->{noUpdateMacrolistView},
   $grp->{noSaveFileStateUpdate}
  )=($win->{macroContext},1,1,1,1,1,1,1);
  _createSearchGrabWindow($grp);
  my $result;
  if (!$no_secondary and !$grp->{searchAlwaysSecondary} and $grp->{searchFilelist}) {
    # avoid opening secondary files
    # during search
    my $first_file_no = $win->{currentFileNo};
    $no_secondary = 1;
    my @locks = ($noCheckLocks,$lockFiles);
    $noCheckLocks = 1;
    $lockFiles=0;

    eval { $result = $callback->($grp,$cont) };
    $no_secondary = 0;
    ($noCheckLocks,$lockFiles)=@locks;
    die $@ if $@;

    my $fsfile = $win->{FSFile};
    if ($win->{currentFileNo} != $first_file_no) {
      lockOpenFile($win,$fsfile);
      # if the initial file and the current file
      # are different, open the secondary files now
      my $status = openSecondaryFiles($win,$fsfile,undef);
      unless ($status->{ok}) {
	$win->toplevel->ErrorReport(
	  -title => "Error: open failed",
	    -message => "A secondary file '$status->{filename}' is unreadable, empty, corrupted, or does not exist!"."\nPossible problem was:",
	  -body => $status->{report},
	 );
      }
    }
  } else {
    $result = $callback->($grp,$cont);
  }
  _closeSearchGrabWindow($grp);
  ($opt_t,
   $win->{noRedraw},
   $grp->{noUpdateTitle},
   $grp->{noUpdatePostponed},
   $grp->{noRecent},
   $grp->{noUpdateStylesheetMenu},
   $grp->{noUpdateMacrolistView},
   $grp->{noSaveFileStateUpdate},
  )=@save;

  get_nodes_win($win);
  redraw_win($win);
  updateTitle($grp);
  updatePostponed($grp);
  updateStylesheetMenu($grp);
  update_macrolist_view($grp);
  saveFileStateUpdate($win);
  unless ($result) {
#    redraw_win($win);
    $grp->{top}->toplevel->
      messageBox(-icon=> 'warning',
		 -message=> $grp->{stopSearch} ? "Interrupted by user!" : "No matching node found!",
		 -title=> 'Find',
		 -default=> 'Ok',
		 -type=> 'ok');
    $grp->{top}->focusForce;
  }
  return $result;
}

######################################
# start searching for a prev node
# and display result unless succeeded
######################################
sub doFindFirstTemplated {
  my ($grp,$cont)=@_;
  return findTemplated($grp,$cont,\&findFirstTemplated);
}
sub doFindPrevTemplated {
  my ($grp,$cont)=@_;
  return findTemplated($grp,$cont,\&findPrevTemplated);
}

######################################
# compare nodes with template
######################################
sub cmpTemplateField {
  my ($grp,$val,$templ)=@_;
  my $method=substr($grp->{templateMatchMethod},0,1);
  return (($val=~ /^$templ$/) ? 1 : 0) if ($method eq 'E');
  return (($val=~ /$templ/) ? 1 : 0) if ($method eq 'R');
  return (($val eq $templ) ? 1 : 0) if ($method eq 'L');
  if ($method eq 'W') {
    $templ=~s/([\[\].^$(){}<>\\])/\\$1/g;
    $templ=~s/\*/.\*/g;
    $templ=~s/\?/./g;
    return (($val=~ /^$templ$/) ? 1 : 0);
  }
  return (($val eq $templ) ? 1 : 0);
}

######################################
# go to next node in searchlist
######################################
sub nextNodeInSearchFilelist {
  my ($grp,$node,$tree)=@_;
  my $win=$grp->{focusedWindow};
  my $haveSearchFL = defined($grp->{searchFilelist});
  my $traverse = $haveSearchFL ? $grp->{searchFilelistTraverse} || 'all' : 'all';

  if ($traverse ne 'node') {
    $node = HNext($win,$node);
    unless ($node) {
      $node = $traverse eq 'all' ? $win->{FSFile}->treeList->[(++$$tree)] : undef;
    }
    return $node if $node || !$haveSearchFL;
  }

  # this realises filelist search
  local $insideEval=1;
  my $result = nextOrPrevFile($grp,1,1,$traverse eq 'all' ? 1 : 0);
  _quick_update($grp);
  # wait for Escape
  while (!$grp->{stopSearch} and $result and !$win->{currentNode}) {
    $result = nextOrPrevFile($grp,1,1,$traverse eq 'all' ? 1 : 0);
    # wait for Escape
    _quick_update($grp);
  }

  if ($result and !$grp->{stopSearch}) {
    if ($traverse eq 'all') {
      $win->{currentNode} = $win->{FSFile}->treeList->[0];
      $$tree = 0;
    }
    elsif ($traverse eq 'tree') {
      $win->{currentNode} = $win->{root};
      $$tree = $win->{treeNo};
    }
    elsif  ($traverse eq 'node') {
      $$tree = $win->{treeNo};
    }
    $win->{treeNo} = -1; # to force redraw in gotoTree
    return $win->{currentNode};
  }
  else {
    #$win->{treeNo} = -1 if ($traverse eq 'all'); # to force redraw in gotoTree
    return undef;
  }
}
######################################
# find next matching node
######################################
sub findFirstTemplated {
  my ($grp,$skipfirst)=@_;

  my $win=$grp->{focusedWindow};
  return unless $win->{FSFile};
  my $search_code = $grp->{searchCode};
  return unless ref($search_code);

  my $node=$win->{currentNode};
  my $tree=$win->{treeNo};
  my $a;
  $grp->{stopSearch}=0;

  $node=nextNodeInSearchFilelist($grp,$node,\$tree) if ($skipfirst);
  while ($node) {
    if ($search_code->($node)) {
      gotoTree($win,$tree);
      setCurrent($win, $node);
      centerTo($win,$node);
      return $node;
    }
  } continue {
    $node=nextNodeInSearchFilelist($grp,$node,\$tree);
  }
  return undef;
}

######################################
# go to the last node of a tree
######################################
sub lastSubtreeNode {
  my ($top)=@_;
  return undef unless $top;
  while ($top->firstson) {
    $top=$top->firstson;
    $top=$top->rbrother while ($top->rbrother);
  }
  return $top;
}

######################################
# go to previous node in search list
######################################
sub prevNodeInSearchFilelist {
  my ($grp,$node,$tree)=@_;
  my $win = $grp->{focusedWindow};
  my $haveSearchFL = defined($grp->{searchFilelist});
  my $traverse = $haveSearchFL ? $grp->{searchFilelistTraverse} || 'all' : 'all';

  if ($traverse ne 'node') {
    $node=HPrev($win,$node);
    if (!$node and $$tree!=0 and $traverse eq 'all') {
      $node=lastSubtreeNode($win->{FSFile}->treeList->[(--$$tree)]);
      $node=HPrev($win,$node) unless (isShown($win,$node));
    }
    return $node if $node or !$haveSearchFL;
  }

  # this realises filelist search
  local $insideEval=1;
  my $no_redraw = $win->{noRedraw};
  $win->{noRedraw}=1;
  my $result = nextOrPrevFile($grp,-1,1,$traverse eq 'all' ? 1 : 0);

  # wait for Escape
  _quick_update($grp);
  while ($result and !$grp->{stopSearch}
	 and !$win->{FSFile} || $win->{FSFile}->lastTreeNo<0) {
    $result = nextOrPrevFile($grp,-1,1,$traverse eq 'all' ? 1 : 0);
    # wait for Escape
    _quick_update($grp);
  }

  $win->{noRedraw}=$no_redraw;

  if ($result and !$grp->{stopSearch}) {
    if ($traverse eq 'all') {
      $$tree=$win->{FSFile}->lastTreeNo;
      $win->{currentNode}=lastSubtreeNode($win->{FSFile}->treeList->[$$tree]);
    }
    elsif ($traverse eq 'tree') {
      $win->{currentNode} = lastSubtreeNode($win->{root});
      $$tree = $win->{treeNo};
    }
    elsif  ($traverse eq 'node') {
      $$tree = $win->{treeNo};
    }
    $win->{treeNo} = -1; # to force redraw in gotoTree
    return $win->{currentNode};
  }
  else  {
    #$win->{treeNo} = -1 if ($traverse eq 'all'); # to force redraw in gotoTree
    return undef;
  }
}

######################################
# find previous matching node
######################################
sub findPrevTemplated {
  my ($grp,$skipfirst)=@_;
  my $win = $grp->{focusedWindow};
  return unless $win->{FSFile};
  my $search_code = $grp->{searchCode};
  return unless ref($search_code);

  my $node=$win->{currentNode};
  my $tree=$win->{treeNo};
  my $a;
  $grp->{stopSearch}=0;

  $node=prevNodeInSearchFilelist($grp,$node,\$tree) if ($skipfirst);
  while ($node) {
    if ($search_code->($node)) {
      gotoTree($win, $tree);
      setCurrent($win, $node);
      centerTo($win,$node);
      return $node;
    }
  } continue {
    $node=prevNodeInSearchFilelist($grp,$node,\$tree);
  }
  return undef;
}

#############################################
#End of Searching functions
#############################################
#############################################
#############################################


sub node_doubleclick_modif {
  my ($w,$grp,$mod)=@_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $node=$tv->get_obj_pinfo($tv->find_item('withtag','current'));
  doEvalHookWithUndo($win,"node_doubleclick_hook",$node,$mod, $w->XEvent);
}

sub node_click_modif {
  my ($w,$grp,$mod)=@_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $node=$tv->get_obj_pinfo($tv->find_item('withtag','current'));
  doEvalHookWithUndo($win,"node_click_hook",$node,$mod, $w->XEvent);
}

sub node_motion_modif {
  my ($w,$grp,$mod)=@_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $node=$tv->get_obj_pinfo($tv->find_item('withtag','current'));
  doEvalHookWithUndo($win,"node_motion_hook",$node,$mod, $w->XEvent);
}

sub text_doubleclick_modif {
  my ($w,$grp,$mod)=@_;
  my $win=findCanvasWindow($grp,$w);
  return unless($win and $win->{FSFile});
  my $attr;

  my $tv=$win->treeView;
  my ($t)=$tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($t);
  setCurrent($win,$node);
  $attr=$tv->get_gen_pinfo("attr")||{};

  doEvalHookWithUndo($win,"text_doubleclick_hook",$node,$attr->{$t},$mod, $w->XEvent);
}

sub text_click_modif {
  my ($w,$grp,$mod)=@_;
  my $win=findCanvasWindow($grp,$w);
  return unless($win and $win->{FSFile});
  my $attr;

  my $tv=$win->treeView;
  my ($t)=$tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($t);
  setCurrent($win,$node);
  ensureCurrentIsDisplayed($win);
  $attr=$tv->get_gen_pinfo("attr")||{};

  doEvalHookWithUndo($win,"text_click_hook",$node,$attr->{$t},$mod, $w->XEvent);
}

sub line_click {
  my ($w,$grp,$button,$double,$modif)=@_;
  my $win=findCanvasWindow($grp,$w);
  return unless($win and $win->{FSFile});

  my $tv=$win->treeView;
  my ($t)=$tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($t);
  setCurrent($win,$node);
  ensureCurrentIsDisplayed($win);
  my $tag=$tv->get_gen_pinfo("tag")||{};
    
  doEvalHookWithUndo($win,"line_click_hook",$node,$tag->{$t},$button, $double,$modif, $w->XEvent);
}


sub editAttrs {
  my ($w,$grp)=@_;
  return if $grp->{inEditAttrs};
  local $grp->{inEditAttrs} = 1;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $node=$tv->get_obj_pinfo($tv->find_item('withtag','current'));
  editAttrsDialog($win,$node);
  ensureCurrentIsDisplayed($win);
}

sub editAttr {
  my ($w,$grp)=@_;
  return if $grp->{inEditAttrs};
  local $grp->{inEditAttrs} = 1;
  my $win=findCanvasWindow($grp,$w);
  return unless($win and $win->{FSFile});
  my $tv=$win->treeView;
  my ($t)=$tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($t);
  setCurrent($win,$node);
  ensureCurrentIsDisplayed($win);
  my $attr=$tv->get_gen_pinfo("attr")||{};
  doEditAttr($win,$node,$attr->{$t}) if defined $attr->{$t};
}


sub doEditAttr {
  my ($win,$node,$attr,$as_type,$focus)=@_;
  my $grp=$win->{framegroup};
  my $result= doEvalHook($win,'do_edit_attr_hook',$attr,$node);
  return 0 if $result eq 'stop';

  return editAttrsDialog_schema($win,$node,$attr,$as_type,$focus)
    if (ref($as_type) or ref($node->type) or
	fileSchema($win->{FSFile}) );

  my ($Entry,@Eopts) = get_entry_type();
  my $newvalue;
  if ($win->{FSFile}->FS->isList($attr)) {
    $newvalue= editListAttr($win,$node->get_member($attr),$attr,$grp->{top},$node);
    if (defined($newvalue)) {
      $win->toplevel->Busy(-recurse=> 1);
      $win->{FSFile}->notSaved(1);
      save_undo($win,prepare_undo($win,"Edit Attribute '$attr'",UNDO_DATA,$node));
      lastActionBookmark($grp);
      $node->set_member($attr,$newvalue);
      doEvalHook($win,"after_edit_attr_hook",$node,$attr,1);
      get_nodes_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
      redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
      $win->toplevel->Unbusy();
      return 1;
    } else {
      doEvalHook($win,"after_edit_attr_hook",$node,$attr,0);
    }
    return;
  }

  if ($node->get_member($attr)=~/^(?:[^\|\\]|\\.)*\|/) {
    $newvalue= editAmbiguousAttr($win,$node->get_member($attr),$attr);
    if (defined $newvalue) {
      $grp->{top}->Busy(-recurse=> 1);
      $win->{FSFile}->notSaved(1);
      save_undo($win,prepare_undo($win,"Edit Attribute '$attr'",UNDO_DATA,$node));
      lastActionBookmark($grp);
      $node->set_member($attr,$newvalue);
      doEvalHook($win,"after_edit_attr_hook",$node,$attr,1);
      get_nodes_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
      redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
      $grp->{top}->Unbusy();
      return 1;
    } else {
      doEvalHook($win,"after_edit_attr_hook",$node,$attr,0);
    }
    return;
  }

  $grp->{top}->Busy(-recurse=> 1);
  my $enabled=doEvalHook($win,'enable_attr_hook',$attr,"normal") ne 'stop';
  $newvalue=encode($node->get_member($attr));
  my $d= $grp->{top}->DialogBox(-title=> ($enabled ? "Edit Node Attribute" : "Disabled Node Attribute"),
			     -buttons=> [($enabled ? ("OK", "Cancel") : "Cancel")]);
  $d->BindReturn($d,1);
  $d->BindEscape();
  $d->resizable(0,0);
  addBindTags($d,'dialog');
  my $l= $d->Label(-text=> $attr,
		    -anchor=> 'e',
		    -justify=> 'right')->pack(-side=>'left');
  my $e= $d->$Entry(@Eopts,
		    -relief=> 'sunken',
		    -width=> 40,
		    -state=> $enabled ? 'normal' : 'disabled',
		    -takefocus=> 1,
		    -font=> $font,
		    -textvariable=> \$newvalue)->pack();
  set_grp_history($grp, $e, "attr-$attr");
  $e->icursor('end');
  $grp->{top}->Unbusy();
  $result= ShowDialog($d,$e,$grp->{top});
  if ($result=~ /OK/) {
    get_grp_history($grp,$e, "attr-$attr");
    $win->{FSFile}->notSaved(1);
    save_undo($win,prepare_undo($win,"Edit Attribute '$attr'",UNDO_DATA,$node));
    lastActionBookmark($grp);
    $node->set_member($attr,decode($newvalue));
    doEvalHook($win,"after_edit_attr_hook",$node,$attr,1);
    get_nodes_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
    redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
  } else {
    doEvalHook($win,"after_edit_attr_hook",$node,$attr,0);
  }
  $d->destroy;
  undef $d;
  return ($result =~ /OK/) ? 1 : 0;
}

#############################################
# redraw tree etc.
#############################################

sub nodeOptions {
  my ($win,$node)=@_;
  return unless $win->{FSFile};
  return $win->treeView->node_options($node,
					$win->{FSFile}->FS,
					$win->{currentNode});
}

sub nodeBoxOptions {
  my ($win,$node,$edge)=@_;
  return unless $win->{FSFile};
  return $win->treeView->node_box_options($node,
					 $win->{FSFile}->FS,
					 $win->{currentNode},$edge);
}

sub redraw_win {
  my ($win)=@_;
  return if ($win->{noRedraw} or $insideEval);
  print STDERR "redraw $win\n" if $tredDebug;
  #------------------------------------------------------------
  #{
  #use Benchmark;
  #my $t0= new Benchmark;
  #for (my $i=0;$i<=50;$i++) {
  #------------------------------------------------------------
  $TrEd::TreeView::on_get_root_style = [\&onGetRootStyle,$win];
  $TrEd::TreeView::on_get_node_style = [\&onGetNodeStyle,$win];
  $TrEd::TreeView::on_redraw_done= [\&onRedrawDone,$win];
  my $vl;
#  $vl=$win->treeView->value_line($win->{FSFile},$win->{treeNo},1,0,$win);
#  $vl=$win->treeView->value_line($win->{FSFile},$win->{treeNo},1,1,$win);
  if ($win->{FSFile} and $win->treeView->get_drawSentenceInfo) {
    $vl=get_value_line($win,$win->{FSFile},$win->{treeNo},1,0,'html');
  }
  $win->{redrawn}++; # may be used to check that this function was called (e.g. during a hook)
                     # do not forget to reset the value first
  $win->treeView->
    redraw($win->{FSFile},
	   $win->{currentNode},
	   $win->{Nodes},
	   # CHANGE THIS (this is just for printing) :
	   (defined($vl) ? $vl : EMPTY),
	   ($stippleInactiveWindows ?
	      (($win == $win->{framegroup}->{focusedWindow}) ? 'hidden' : 'normal')
		: undef),
	   $win
	  );
  if ($win->{FSFile}) {
    setCurrent($win,$win->{currentNode});
    ensureCurrentIsDisplayed($win);
  }
  $TrEd::TreeView::on_get_root_style= undef; #forget the reference on $win
  $TrEd::TreeView::on_get_node_style= undef;
  $TrEd::TreeView::on_redraw_done= undef;

  if ($win == $win->{framegroup}->{focusedWindow}) {
    saveFileStateUpdate($win);
    resetUndoStatus($win);
    resetTreePosStatus($win->{framegroup});
    update_status_info($win);
    updateNodeMenu($win);
  }

  #------------------------------------------------------------
  #}
  #my $t1= new Benchmark;
  #my $td= timediff($t1, $t0);
  #print "redraw: the code took:",timestr($td),"\n";
  #}
  #------------------------------------------------------------

  return;
}

sub redraw_fsfile {
  my ($grp,$fsfile)=@_;
  return if $insideEval or !$fsfile;
  foreach (fsfileDisplayingWindows($grp,$fsfile)) {
    redraw_win($_);
  }
  return;
}

sub redraw_stylesheet {
  my ($grp,$stylesheet)=@_;
  foreach my $win (stylesheetUsingWindows($grp,$stylesheet)) {
    applyWindowStylesheet($win,$stylesheet);
    redraw_win($win);
  }
  return;
}


sub redraw_fsfile_tree {
  my ($grp,$fsfile,$tree_no)=@_;
  return if $insideEval or !$fsfile;
  foreach (grep {$_->{treeNo} == $tree_no}
	   fsfileDisplayingWindows($grp,$fsfile)) {
    redraw_win($_);
  }
  return;
}

sub redraw_all {
  my ($grp)=@_;
  foreach (@{ $grp->{treeWindows} }) {
    redraw_win($_);
  }
  return;
}

sub follow_mouse {
  my ($w, $grp)= @_;
  my $e= $w->XEvent;
  my $win=findCanvasWindow($grp,$w);
  my($x, $y)= ($e->x,$e->y);
  scrollCanvasToXY($w, $win, $x, $y);
}

sub follow_mouse_press {
  my ($w, $grp)= @_;
  my $win=findCanvasWindow($grp,$w);
  my $e = $w->XEvent;
  initScrollOrigin($w,$win,$e->x,$e->y);
}
sub initScrollOrigin {
  my ($w, $win, $X, $Y)=@_;
  $win->treeView->store_gen_pinfo('scroll_origin',
				  [$X,$Y,$w->canvasx($X),$w->canvasy($Y)]);
}
#
# How this works:
# - initScrollOrigin registeres the initial window position of the mouse
# pointer and the corresponding canvas position
# - when the mouse moves towards an edge of the window,
# the view moves so that when it reaches the edge,
# the corresponding edge of the canvas drawing area
# (0,0,canvasWidth,canvasHeight) is reached.
# - If the mouse returns to the initial window position,
# the initial canvas point is also under the mouse pointer.
# - If the corresponding canvas edge is already visible, we do
# not move towards it.
#
# known bugs: if initially a negative canvas coord is seen
#


sub scrollCanvasToXY {
  my ($w, $win, $X, $Y)=@_;
  no integer;
  my $tv=$win->treeView;
  my @s = $w->cget('-scrollregion');
  if ($w->isa('Scrolled')) {
    $w=$w->Subwidget('scrolled');
  }
  my ($Ht,$ht,$Wd,$wd);
  my $origin = $tv->get_gen_pinfo('scroll_origin');
  return unless defined $origin;
  my ($cx,$cy);
  if ($X<$origin->[0]) {
    unless ($w->canvasx(0)<$s[0]) {
      ($wd,$Wd)=($origin->[0],$origin->[2]-$s[0]);
      $cx=$s[0]+($X/$wd) * $Wd;
    }
  } else {
    my $width = $w->width;
    unless ($w->canvasx($width)>$s[2]) {
      ($wd,$Wd)=($width-$origin->[0],$s[2]-$origin->[2]);
      $cx=$origin->[2]+(($X-$origin->[0])/$wd) * $Wd;
    }
  }
  if ($Y<$origin->[1]) {
    unless ($w->canvasy(0)<$s[1]) {
      ($ht,$Ht)=($origin->[1],$origin->[3]-$s[1]);
      $cy=$s[1]+($Y/$ht) * $Ht;
    }
  } else {
    my $height = $w->height;
    unless ($w->canvasy($height)>$s[3]) {
      ($ht,$Ht)=($height-$origin->[1],$s[3]-$origin->[3]);
      $cy=$origin->[3]+(($Y-$origin->[1])/$ht) * $Ht;
    }
  }
  $w->xviewCoord($cx, $X) if defined $cx and $cx>=$s[0] and $cx<=$s[2];
  $w->yviewCoord($cy, $Y) if defined $cy and $cy>=$s[1] and $cy<=$s[3];
  return;
}

sub ensureCurrentIsDisplayed {
  my ($win)=@_;
  return unless $win->{FSFile};
  my $node = $win->{currentNode};
  while ($node and !$win->treeView->node_is_displayed($node)) {
    $node = $node->parent;
  }
  if (!$node) {
    my $rtl = treeIsReversed($win);
    if ($rtl) {
      $node = $win->{Nodes}->[-1];
    } else {
      $node = $win->{Nodes}->[0];
    }
  }
  if ($node and $node != $win->{currentNode}) {
    setCurrent($win,$node);
  }
}

sub treeIsVertical {
  my ($grp) = @_;
  my $win=$grp->{focusedWindow};
  return unless $win;
  return $win->treeView->get_verticalTree;
}

sub treeIsReversed {
  my ($grp_win) = @_;
  my $win=cast_to_win($grp_win);
  return unless $win;
  my $rtl = $win->treeView->rightToLeft($win->{FSFile});
  return $rtl if defined $rtl;
  return $win->treeView->get_reverseNodeOrder;
}

sub currentLeft {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  return unless $win->{FSFile};
  my $node =$win->{currentNode};
  my $dp=DisplayedAncestor($win,$node);
  $node = PrevDisplayed($win,$node,$dp);
  while ($node) {
    my $ndp = DisplayedAncestor($win,$node);
    last if $ndp == $dp;
    $node = $ndp;
  }
  if ($node) {
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}

sub currentRight {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  return unless $win->{FSFile};
  my $node =$win->{currentNode};
  my $dp=DisplayedAncestor($win,$node);
  $node = NextDisplayed($win,$node->rightmost_descendant,$dp);
  if ($node and $dp == DisplayedAncestor($win,$node)) {
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}

sub currentRightLin {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $tv =$win->treeView;
  my @nodes = grep { $tv->node_is_displayed($_) } @{$win->{Nodes}};
  my $node = $win->{currentNode};
  my $idx = Index(\@nodes,$node);
  if ($idx<$#nodes) {
    $node = $nodes[$idx+1];
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}
sub currentLeftLin {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $tv =$win->treeView;
  my @nodes = grep { $tv->node_is_displayed($_) } @{$win->{Nodes}};
  my $node = $win->{currentNode};
  my $idx = Index(\@nodes,$node);
  if ($idx>0) {
    $node = $nodes[$idx-1];
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}

sub currentRightWholeLevel {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $tv = $win->treeView;
  return unless $win->{FSFile};
  my @nodes = grep { $tv->node_is_displayed($_) } @{$win->{Nodes}};
  my $node = $win->{currentNode};
  my $level = $tv->get_node_pinfo($node,'Level');
  my $idx = Index(\@nodes,$node);
  while ($idx<$#nodes) {
    $node = $nodes[++$idx];
    if ($level==$tv->get_node_pinfo($node,'Level')) {
      setCurrent($win,$node);
      centerTo($win,$win->{currentNode});
      return;
    }
  }
  return;
}

sub currentLeftWholeLevel {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $tv = $win->treeView;
  return unless $win->{FSFile};
  my @nodes = grep { $tv->node_is_displayed($_) } @{$win->{Nodes}};
  my $node = $win->{currentNode};
  my $level = $tv->get_node_pinfo($node,'Level');
  my $idx = Index(\@nodes,$node);
  while ($idx>0) {
    $node = $nodes[--$idx];
    if ($level==$tv->get_node_pinfo($node,'Level')) {
      setCurrent($win,$node);
      centerTo($win,$win->{currentNode});
      return
    }
  }
  return;
}

sub currentDown {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  return unless $win->{FSFile};
  my $node = $win->{currentNode}->firstson;
  while ($node and !$win->treeView->node_is_displayed($node)) {
    $node = NextDisplayed($win,$node,$win->{currentNode});
  }
  if ($node) {
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}

sub currentUp {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $node = $win->{currentNode};
  $node = $node && $node->parent;
  while ($node and !$win->treeView->node_is_displayed($node)) {
    $node = $node->parent;
  }
  if ($node) {
    setCurrent($win,$node);
    centerTo($win,$win->{currentNode});
  }
}

sub centerToXY {
  my ($win, $x, $y)= @_;
  my $c = $win->treeView->canvas;
  $c->xviewCenter(coord => $x);
  $c->yviewCenter(coord => $y);
#   my ($ax,$bx)=$win->treeView->canvas->xview;
#   my ($ay,$by)=$win->treeView->canvas->yview;

#   my $shiftx=($bx-$ax)/2;
#   my $shifty=($by-$ay)/2;
#   eval {
#     $win->treeView->canvas->xview(moveto=> min2(max2(0,$x/$win->treeView->{canvasWidth}-$shiftx),1))
#       if ($win->treeView->{canvasWidth}-$shiftx);
#     $win->treeView->canvas->yview(moveto=> min2(max2(0,$y/$win->treeView->{canvasHeight}-$shifty),1))
#       if ($y/$win->treeView->{canvasHeight}-$shifty);
#   }
}

sub centerTo {
  my ($win, $node)= @_;
  return unless $node;
  return if $win->{noRedraw};
  my $tv=$win->treeView;
  $tv->reset_scroll_region;
  centerToXY($win,
	     $tv->get_node_pinfo($node,"XPOS"),
	     $tv->get_node_pinfo($node,"YPOS"));
}

sub doEvalHookWithUndo {
  _evalHook(1,@_);
}
sub doEvalHook {
  _evalHook(0,@_);
}
sub _evalHook {
  my ($with_undo,$win,$hook)=(shift,shift,shift);

  return unless $hook; # and $win->{currentNode};
  my $grp = $win->{framegroup};
  # Save current position (as last action position)
  my $bookmark= $with_undo ? bookmarkThis($grp) : undef;


  local $insideEval=1;
  my $old_ctxt = TrEd::Macros::save_ctxt();
  my $context='TredMacro';
  set_macro_variable(
    FileNotSaved => '?',
    libDir => $libDir,
    forceFileSaved => 0
   );
  my $minor_modes;
  if ($win) {
    set_macro_variable(
      this => $win->{currentNode},
      root => $win->{root},
      grp => $win,
     );
    $context = $win->{macroContext} || 'TredMacro';
    $minor_modes = $win->{minorModes};
    if (ref($minor_modes)) {
      my $pre_hooks = $grp->{minorPreHooks}{$hook};
      for my $minor (@$minor_modes) {
	my $pre_hook = $pre_hooks->{$minor};
	if (defined $pre_hook) {
	  print STDERR "running pre-hook $hook for $minor : $pre_hook\n"  if $hookDebug;
	  eval { $pre_hook->(@_) };
	  errorMessage($win,$@) if $@;
	}
      }
    }
  }
  my $undo=prepare_undo($win,"Hook $context"."->".$hook,UNDO_DISPLAYED_TREES) if ($with_undo and $win and $win->{FSFile});
  my $result=do_eval_hook($win,$context,$hook,@_);
  warn "$@\n" if $@;
  if (ref($minor_modes)) {
    my $post_hooks = $grp->{minorPostHooks}{$hook};
    for my $minor (@$minor_modes) {
      my $post_hook = $post_hooks->{$minor};
      if (defined $post_hook) {
	print STDERR "running post-hook $hook for $minor : $post_hook\n" if $hookDebug;
	eval { $post_hook->(@_,$result) };
	errorMessage($win,$@) if $@;
      }
    }
  }
  my $file_changed=get_macro_variable("FileNotSaved");

  if ($win) {
    if ($win->{FSFile}) {
      if ($file_changed ne '?' and $file_changed) {
	if ($with_undo) {
	  save_undo($win,$undo);
	  lastActionBookmark($win->{framegroup},$bookmark);
	}
	$win->{FSFile}->notSaved(1);
      }
    }
    saveFileStateUpdate($win);
  }

  TrEd::Macros::restore_ctxt($old_ctxt);
  print STDERR "Hook $hook returned $result\n" if $hookDebug;
  return $result;
}


sub examineEvent {
  my $w = shift;
  my $bindings = shift;
  my $grp = $_[0];
  my ($macro,$key,$eA,$eK,$by_event_hook, $rotated) = resolveEvent($w,@_);
  if ($eA eq $eK) {
    $key .= " [$eA]" if ($eA ne $key);
  } else {
    my $rot =  $rotated ? ' /rotated because of vertical mode/ ' : '';
    if ($eA eq $key) {
      $key .= " [$eK]$rot";
    } elsif ($eK eq $key) {
      $key .= " [$eA]$rot";
    } else {
      $key .= " [$eA = $eK]$rot";
    }
  }
  if ($by_event_hook) {
    if (defined($macro)) {
      $$bindings = "$key bound by event_hook to: ".findMacroDescription($grp,$macro);
    } else {
      $$bindings = "$key is blocked by event_hook\n";
    }
  } else {
    if (defined($macro)) {
      $$bindings = "$key is bound to: ".findMacroDescription($grp,$macro);
    } else {
      $$bindings = "$key is not bound\n";
    }
  }
  print $$bindings."\n";
  Tk->break;
}

sub examineBindingsDialog {
  my ($grp)=@_;
  my $bindings='None';
  my $d = $grp->{top}->DialogBox(-title=> "Examine key bindings",
				 -buttons=> ["Close"]);
#   $d->Label(-text=> $attr,
# 		    -anchor=> 'e',
# 		    -justify=> 'right')->pack(-side=>'left');
  $d->BindEscape;
  $d->Label(qw/-wraplength 6i -justify left -text/,
	    "Press any key to see it's binding in the current context.")->
	      pack(qw/-padx 0 -pady 10 -expand yes -fill both/);
  my $t=$d->Label(-textvariable => \$bindings)->pack(qw/-padx 0 -pady 10 -expand yes -fill both/);

  $d->bind('<KeyPress>'=> [\&examineEvent, \$bindings, $grp, EMPTY ]);

  foreach my $prefix ('Alt','Meta','Mod4') {
    $d->bind("<$prefix-KeyPress>"=> [\&examineEvent, \$bindings, $grp, uc($prefix).'+' ]);
  }
  foreach (qw(Shift Control Meta Alt Mod4 Control-Shift Control-Alt
              Control-Meta Control-Mod4 Alt-Shift Alt-Mod4 Meta-Shift Mod4-Shift)) {
    foreach my $event (qw(KeyPress Right Left Up Down
                          Return comma period Next Prior greater less)) {
      $d->bind("<$_-$event>"=> [\&examineEvent, \$bindings, $grp, keyBind($_)."+"])
	unless ("$_-$event" eq "Alt-KeyPress" or "$_-$event" eq "Meta-KeyPress");
    }
  }

  my $set_bindings_func = sub { $bindings = "builtin $_[2] - $_[1]"; Tk->break; };
  while (my ($key, $def) = each %default_binding) {
    $d->bind($key => [ $set_bindings_func, $def->[1], $key ]);
  }

  my $context = $grp->{focusedWindow}->{macroContext};
  my $set_override_func = sub { $bindings = "builtin $_[2] overriden in $context - $_[1]"; Tk->break; };
  while (my ($key, $def) = each %{$context_override_binding{$context}||{}}) {
    $d->bind($key => [ $set_override_func, $def->[1], $key ]);
  }


  $d->Show;
  $d->destroy;
  undef $d;
}

sub findMacroDescription {
  my ($grp_or_win,$macro)=@_;
  if (!ref($macro) and $macro =~ /^(.*)->/) {
    my $b = $menuBindings{$1};
    my ($desc) = grep { ref($b->{$_}) and $b->{$_}[0] eq $macro } keys %$b;
    return "$desc ($macro)" if $desc ne EMPTY;
    return "macro $macro";
  } else {
    my ($grp,$win)=grp_win($grp_or_win);
    for my $context (uniq($win->{macroContext},"TredMacro")) {
      my $Menus = $menuBindings{$context};
      my %macro_to_menu = map { $Menus->{$_}->[0] => $_ } keys %{ $Menus };
      my $desc = $macro_to_menu{$macro};
      return $desc." (inline code)" if defined $desc;
    }
    return "this macro has no description (inline code)";
  }
}

sub doEvalMacro {
  my ($win,$macro)=(shift,shift);
  return unless $macro;# and $win->{currentNode};
  my $bookmark=bookmarkThis($win->{framegroup});
  $win->toplevel->Busy(-recurse=> 1);
  $insideEval=1;

  set_macro_variable(
    this => $win->{currentNode},
    root => $win->{root},
    libDir => $libDir,
    FileNotSaved => '?',
    forceFileSaved => 0,
    Redraw => 'file');

  my $undo=prepare_undo($win,findMacroDescription($win,$macro,UNDO_DISPLAYED_TREES));
  my $result=do_eval_macro($win,$macro);
  my $current_win=get_macro_variable("grp");
  if ($win != $current_win and (blessed($current_win) and $current_win->isa('TrEd::Window')) ) {
    $win = $current_win;
  }
  my $current=get_macro_variable("this");
  my $file_not_saved=get_macro_variable("FileNotSaved");
  $file_not_saved=1 if $file_not_saved eq '?';
  if ($win->{FSFile}) {
    if (get_macro_variable("forceFileSaved")) {
      print STDERR "Macro forcedly claims file saved.\n";
      $win->{FSFile}->notSaved($file_not_saved ? 1 : 0);
      lastActionBookmark($win->{framegroup},$bookmark) if $file_not_saved;
    } else {
      if ($file_not_saved) {
	save_undo($win,$undo);
	$win->{FSFile}->notSaved(1);
	lastActionBookmark($win->{framegroup},$bookmark);
      } else {
	print STDERR "Macro claims file untouched.\n" if $macroDebug;
      }
    }
  }
  $insideEval=0;
  #------------------------------------------------------------
  #use Benchmark;
  #my $t0= new Benchmark;
  #for (my $i=0;$i<=50;$i++) {
  ### ??? 4kb/50 runs memory leaks in redraw (probably in Tk)
  #------------------------------------------------------------
  if (get_macro_variable("Redraw") eq 'all') {
    get_nodes_all($win->{framegroup});
    redraw_all($win->{framegroup});
  } elsif (get_macro_variable("Redraw") eq 'win') {
    get_nodes_win($win);
    redraw_win($win);
  } elsif (get_macro_variable("Redraw") eq 'tree') {
    get_nodes_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
    redraw_fsfile_tree($win->{framegroup},$win->{FSFile},$win->{treeNo});
  } elsif (get_macro_variable("Redraw") eq 'tie') {
    if ($win->{framegroup}->{tieWindows}) {
      get_nodes_all($win->{framegroup});
      redraw_all($win->{framegroup});
    } else {
      get_nodes_win($win);
      redraw_win($win);
    }
  } elsif (get_macro_variable("Redraw") eq 'none') {
    # do nothing
  } else {
    get_nodes_fsfile($win->{framegroup},$win->{FSFile});
    redraw_fsfile($win->{framegroup},$win->{FSFile});
  }
  #------------------------------------------------------------
  #}
  #my $t1= new Benchmark;
  #my $td= timediff($t1, $t0);
  #print "${TredMacro::FileNotSaved} the code took:",timestr($td),"\n";
  #------------------------------------------------------------

  # the rest of this routine is:
  # memory ok, speed ok
  setCurrent($win,$current) if ($current);
  ensureCurrentIsDisplayed($win);

  set_macro_variable(
    this => undef,
    root => undef,
    grp => undef
   );

  centerTo($win,$win->{currentNode});
  updateTitle($win->{framegroup});

  $win->toplevel->Unbusy;
  return $result;
}

sub resolveKey {
  my $grp = shift; # other arguments are keys
  my $win = $grp->{focusedWindow};
  my $minor_modes=$win->{minorModes};
  my $bindings;
  if ($minor_modes) {
    foreach my $minor_mode (@$minor_modes) {
      $bindings = $grp->{minorKeyPriorityBindings}{$minor_mode};
      foreach my $key (@_) {
	if ($bindings and exists $bindings->{$key}) {
	  return($bindings->{$key},$key);
	}
      }
    }
  }
  foreach my $context (uniq($win->{macroContext},"TredMacro")) {
    foreach my $key (@_) {
      if (exists ($keyBindings{$context}->{$key})) {
	return($keyBindings{$context}->{$key},$key)
      }
    }
  }
  if ($minor_modes) {
    foreach my $minor_mode (@$minor_modes) {
      $bindings = $grp->{minorKeyBindings}{$minor_mode};
      foreach my $key (@_) {
	if ($bindings and exists $bindings->{$key}) {
	  return($bindings->{$key},$key);
	}
      }
    }
  }
  return undef;
}

sub resolveEvent {
  my ($w,$grp,$prefix)=@_;
  my $key;
  my $e= $w->XEvent;
  my $A= $e->A;
  my $K= $e->K;
  my @possib=();
  my $macro=undef;
  my $rotated = 0;
  if (treeIsVertical($grp) and exists $vertical_key_arrow_map{$K}) {
    print STDERR "vertical tree: translating $K to " if $keyboardDebug;
    $K = $vertical_key_arrow_map{$K};
    print STDERR "$K\n" if $keyboardDebug;
    $rotated  = 1;
  }

  print STDERR "Prefix: $prefix\n" if $keyboardDebug;
  $prefix=~s/SHIFT\+//g unless ($K=~/^(?:left|right|up|down|next|prior|space|backspace|insert|delete|return|pause|escape|home|end|begin|select|print|execute|undo|redo|menu|find|cancel|help|break|F[0-9]+|L[0-9]+|R[0-9]+|ISO_Left_Tab)$/i);
  if ($keyboardDebug) {
    print STDERR "Pressed: (".ord($A)."), prefix $prefix, keysym $K/",$e->N,"\n";
    print STDERR "Maybe: $prefix$K\n";
  }
  if ($K =~ /^XF86_Switch_VT_(\d+)$/) {
    print STDERR "Translating $prefix $K to SHIFT+F$1\n" if $keyboardDebug;
    $prefix='SHIFT+';
    $K='F'.$1;
  }
  push @possib, ($prefix.$A,$prefix.$K);

  $macro = doEvalHook($grp->{focusedWindow},"event_hook",$e,$w,@possib);
  if (defined($macro)) {
    if ($macro eq 'stop') {
      print STDERR "Event blocked by event_hook\n" if $macroDebug || $keyboardDebug;
      return (undef,undef,$prefix.$A,$prefix.$K,1,$rotated);
    } else {
      print STDERR "Event translated by event_hook to '$macro'\n" if $macroDebug || $keyboardDebug;
      return ($macro,$key,$prefix.$A,$prefix.$K,1,$rotated);
    }
  } else {
    ($macro,$key)=resolveKey($grp,@possib);
    return ($macro,$key,$prefix.$A,$prefix.$K,undef,$rotated);
  }
}

sub evalMacro {
  my ($w,$grp,$prefix)=@_;
  my $win=$grp->{focusedWindow};

  my ($macro,$key)=resolveEvent($w,$grp,$prefix);
  if (defined $macro) {
    $grp->{statusLineText}="$key" if $tredDebug;
    $grp->{statusLineText}.=", $macro" if $tredDebug;
    update_status_info($win) if $tredDebug;
#    use Benchmark;
#    my $t0= new Benchmark;
#    # ... your code here ...
#    for (my $i=0;$i<=50;$i++) {
    doEvalMacro($win,$macro);
#    }
#    my $t1= new Benchmark;
#    my $td= timediff($t1, $t0);
#    print "the code took:",timestr($td),"\n";

    return 1;
  } else {
    $grp->{statusLineText}=$key if $tredDebug; #"$prefix$K" if $tredDebug;
    update_status_info($win) if $tredDebug;
  }
  return undef;
}

sub tieGotoTree {
  my ($grp,$no)=@_;
  if ($grp->{tieWindows}) {
    my @tied = grep { $_->{FSFile} } @{$grp->{treeWindows}};
    if (@tied) {
      my $result = 1;
      foreach (@tied) {
	$result &&= gotoTree($_,$no);
      }
      return $result;
    } else {
      return 0
    }
  } else {
    if ($grp->{focusedWindow}->{FSFile}) {
      return gotoTree($grp->{focusedWindow},$no);
    } else {
      return 0;
    }
  }
}

sub tieNextTree {
  my ($grp)=@_;
  if ($grp->{tieWindows}) {
    my @tied = grep { $_->{FSFile} } @{$grp->{treeWindows}};
    if (@tied) {
      my $result = 1;
      foreach (@tied) {
	$result &&= nextTree($_);
      }
      return $result;
    } else {
      return 0
    }
  } else {
    if ($grp->{focusedWindow}->{FSFile}) {
      my $result = nextTree($grp->{focusedWindow});
      return $result;
    } else {
      return 0;
    }
  }
}

sub tiePrevTree {
  my ($grp)=@_;
  if ($grp->{tieWindows}) {
    my @tied = grep { $_->{FSFile} } @{$grp->{treeWindows}};
    if (@tied) {
      my $result = 1;
      foreach (@tied) {
	$result &&= prevTree($_);
      }
      return $result;
    } else {
      return 0
    }
  } else {
    if ($grp->{focusedWindow}->{FSFile}) {
      my $result = prevTree($grp->{focusedWindow});
      return $result;
    } else {
      return 0;
    }
  }
}

sub currentNext {
  my ($win)=@_;
  my $next=NextDisplayed($win,$win->{currentNode});
  if ($next) {
    setCurrent($win,$next);
    centerTo($win,$win->{currentNode});
  }
}


sub currentPrev {
  my ($win)=@_;
  my $prev=PrevDisplayed($win,$win->{currentNode});
  if ($prev) {
    setCurrent($win,$prev);
    centerTo($win,$win->{currentNode});
  }
}

sub node_select {
  my($w,$grp)= @_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $e= $w->XEvent;
  my($x, $y)= ($e->x, $e->y);
  my ($canvas_obj) = $tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($canvas_obj);
  setCurrent($win,$node);
}

{
  my ($nx,$ny);
sub node_down {
  my($w,$grp,$scroll)= @_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my $e= $w->XEvent;
  ($nx, $ny)= ($e->x, $e->y);
  if ($scroll) {
    initScrollOrigin($w,$win,$nx,$ny);
  }
  my ($canvas_obj) = $tv->find_item('withtag','current');
  my $node=$tv->get_obj_pinfo($canvas_obj);

  unless (first { $_ eq 'point' } $w->gettags($canvas_obj)) {
    my ($cx,$cy)=($w->canvasx($nx),$w->canvasy($ny));
    $canvas_obj = first {
      first { $_ eq 'point' } $w->gettags($_)
    } $tv->find_item(overlapping => $cx-1,$cy-1,$cx+1,$cy+1);
    if ($canvas_obj and $node!=$tv->get_obj_pinfo($canvas_obj)) {
      undef $canvas_obj;
    }
  }
  setCurrent($win,$node);
  $w->dtag('selected');
  return unless $canvas_obj;
  $w->addtag('selected', 'withtag', $canvas_obj);
  $w->raise('selected');
  $w->raise("text[$node]");
}				# end plot_down

sub node_move {
  my($w,$grp,$scroll)= @_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  my ($sel)=$tv->find_item('withtag','selected');
  return unless $sel;

  my $e= $w->XEvent;
  my ($deltax,$deltay) = (-$nx,-$ny);
  ($nx,$ny)= ($e->x, $e->y);
  $deltax+=$nx; $deltay+=$ny;
  my ($cx, $cy)= ($w->canvasx($nx),$w->canvasy($ny));
  if ($scroll) {
    $deltax-=$cx; $deltay-=$cy;
    scrollCanvasToXY($w, $win, $nx, $ny);
    ($cx, $cy)= ($w->canvasx($nx),$w->canvasy($ny));
    $deltax+=$cx; $deltay+=$cy;
  }
  $w->move('selected',$deltax,$deltay);
  my $nearest=$tv->get_obj_pinfo($tv->find_item('withtag','nearest'));
  if ($nearest) {
    $w->itemconfigure('nearest',nodeOptions($win,$nearest));
    $tv->apply_stored_style_opts("Oval",$nearest);
    $w->dtag('nearest');
  }

  my @nodes= $w->find('withtag','point');
  my $node=$tv->get_obj_pinfo($sel);
  my $bestDist=10000;
  my $dist;
  $nearest=undef;
  foreach my $p (@nodes) {
    my @b = $w->bbox($p);
    my ($dX,$dY) = (($b[2]+$b[0])/2-$cx,($b[3]+$b[1])/2-$cy);
    my $n=$tv->get_obj_pinfo($p);
    if ($n and $n!=$node) {
      $dist=$dX*$dX+$dY*$dY;
      if ($bestDist>$dist) {
	$bestDist=$dist;
	$nearest=$p;
      }
    }
  }
  if (defined($nearest) and $bestDist<800) {
    $w->addtag('nearest','withtag',$nearest);
    $w->itemconfigure($nearest, -fill=> $tv->get_nearestNodeColor);
  }
}				# end plot_move
}
sub node_release {
  my($w,$grp,$button)= @_;
  my $win=findCanvasWindow($grp,$w);
  return unless $win->{FSFile};

  my $tv=$win->treeView;
  my ($sel)=$tv->find_item('withtag','selected');
  return unless $sel;

  my $e= $w->XEvent;
  my($x, $y)= ($e->x, $e->y);
  my $parent;
  my $node;
  my $center=0;
  $node=$tv->get_obj_pinfo($sel) if (defined ($sel));
  if ($node) {
    my ($p)=$tv->find_item('withtag','nearest');
    $w->dtag('nearest');
    $w->dtag('selected');
    if (defined $p) {
      $parent=$tv->get_obj_pinfo($p);
      $w->itemconfigure($tv->get_node_pinfo($parent,"Oval"),
			  nodeOptions($win,$parent));
      $tv->apply_stored_style_opts("Oval",$parent);
      if (doEvalHookWithUndo($win,"node_release_hook",$node,$parent,"$button",$e) ne 'stop') {
	if ($parent->test_child_type($node) or
	    userQuery($win,"WARNING:\n\n".
			"The target node does not permit the dragged node ".
			  "as a child.\nThe resulting tree will be invalid.\n\n",
		      -bitmap=> 'question',
		      -title => 'Incompatible node type',
		      -buttons => ["Do not paste",'Paste anyway']) eq 'Paste anyway') {
	  my $top=$parent;
	  while ($top) {
	    if ($node eq $top) {
	      undef $parent;
	      last;
	    }
	    $top=$top->parent;
	  }
	  if ($parent and $node->parent!=$top) {
	    save_undo($win,prepare_undo($win, "Cat/Paste node with mouse"),UNDO_DISPLAYED_TREES);
	    my $oldparent=$node->parent;
	    $node->cut()->paste_on(
			 $parent,
			 $win->{FSFile}->FS);
	    $win->{FSFile}->notSaved(1);
	    doEvalHook($win,"node_moved_hook",$node,$oldparent);
	    lastActionBookmark($grp);
	    get_nodes_fsfile($grp,$win->{FSFile});
	    redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo});
	    centerTo($win,$win->{currentNode});
	    return;
	  }
	}
      }
    }
    # returning node to its position
    $w->coords($sel, $tv->node_coords($node,$win->{currentNode}));
    # print lower;
    $w->lower($sel,'point');
  } else { redraw_win($win); }
}

sub node_release_modif {
  my($w,$grp,$mod)= @_;
  my $win=findCanvasWindow($grp,$w);
  my $tv=$win->treeView;
  return unless $win->{FSFile};
  my $e= $w->XEvent;
  my($x, $y)= ($e->x, $e->y);
  my $parent;
  my $node;
  my $center=0;
  my ($sel)=$tv->find_item('withtag','selected');
  $node=$tv->get_obj_pinfo($sel) if (defined ($sel));
  if ($node) {
    my ($p)=$tv->find_item('withtag','nearest');
    $w->dtag('nearest');
    if (defined $p) {
      $parent=$tv->get_obj_pinfo($p);
      $w->itemconfigure($tv->get_node_pinfo($parent,"Oval"),
			  nodeOptions($win,$parent));
      doEvalHookWithUndo($win,"node_release_hook",$node,$parent,$mod,$e);
    } else {
      doEvalHookWithUndo($win,"node_release_hook",$node,undef,$mod,$e);
    }
    # try to detect that the tree was redrawn
    if ($tv->find_item('withtag','selected')) {
      # returning selected node to its position
      $w->dtag('selected');
      $w->coords($sel, $tv->node_coords($node,$win->{currentNode}));
    }
  } else { redraw_fsfile_tree($grp,$win->{FSFile},$win->{treeNo}); }
}

sub prepare_undo {
  my ($win,$message,$what,$data)=@_;
  return unless $maxUndo;
  my $fsfile=$win->{FSFile};
  return undef unless $fsfile;
  $what||=UNDO_DISPLAYED_TREES;
  my $snapshot;
  if ($what == UNDO_ACTIVE_NODE) {
    $data=$win->{currentNode};
  } elsif ($what == UNDO_ACTIVE_ROOT) {
    $data=$win->{currentNode};
    return unless ref $data;
    $data = $data->root;
  } elsif ($what == UNDO_CURRENT_TREE) {
    return if !ref($win->{root});
    $data=$win->{root};
  } elsif ($what == UNDO_TREE_ORDER) {
    $snapshot = [@{$fsfile->treeList}];
  } elsif ($what == UNDO_DISPLAYED_TREES) {
    my $n = $win->{Nodes} || [];
    my %n; @n{@$n}=();
    # the following should be a bit faster than uniq map $_->root, @$n
    $data = [uniq map { my $p=$_->parent; $p && exists($n{$p}) ? () : ($p ? $p->root : $_) }  @$n ];
  } elsif ($what == UNDO_DATA_AND_TREE_ORDER) {
    if (ref($data)) {
      $snapshot = [make_data_snapshot($data),
		   [@{$fsfile->treeList}]
		  ];
    } else {
      $what=UNDO_TREE_ORDER;
      $snapshot = [@{$fsfile->treeList}];
    }
  } elsif ($what == UNDO_CURRENT_TREE_AND_TREE_ORDER) {
    return if !ref($win->{root});
    $snapshot = [make_data_snapshot($win->{root}),
		 [@{$fsfile->treeList}]
		];
  } elsif ($what == UNDO_ACTIVE_ROOT_AND_TREE_ORDER) {
    my $n = $win->{currentNode};
    return unless ref $n;
    $snapshot = [make_data_snapshot($n->root),
		 [@{$fsfile->treeList}]
		];
  } elsif ($what == UNDO_DATA) {
    # $data = $data;
  } else {
    ErrorMessage($win, "Unknown undo type: $what\n");
    return;
  }
  if (!defined $snapshot) {
    return unless ref $data;
    $snapshot = [make_data_snapshot( $data ),$data];
  }
  return [$fsfile,['Snapshot',$win->{treeNo},$snapshot,$win->{currentNode},$message,$what]];
}

sub prepare_redo {
  my ($win,$undo)=@_;
  my $type = $undo->[0];
  my $message = $undo->[4];
  return prepare_undo($win,$message) unless $type eq 'Snapshot';
  my $what = $undo->[5];
  my $snapshot=$undo->[2];
  $what||=UNDO_DISPLAYED_TREES;
  if ($what == UNDO_ACTIVE_NODE or
      $what == UNDO_ACTIVE_ROOT or
      $what == UNDO_DATA or
      $what == UNDO_CURRENT_TREE or
      $what == UNDO_DISPLAYED_TREES
     ) {
    return prepare_undo($win,$message,UNDO_DATA,$snapshot->[1]);
  } elsif ($what == UNDO_TREE_ORDER) {
    return prepare_undo($win,$message,UNDO_TREE_ORDER);
  } elsif ($what == UNDO_CURRENT_TREE_AND_TREE_ORDER or
	   $what == UNDO_ACTIVE_ROOT_AND_TREE_ORDER or
	   $what == UNDO_DATA_AND_TREE_ORDER) {
    return prepare_undo($win,$message,UNDO_DATA_AND_TREE_ORDER,$snapshot->[1]);
  } else {
    ErrorMessage($win, "Unknown undo type: $what\n");
    return prepare_undo($win,$message);
  }
}


sub save_undo {
  my ($win,$undo)=@_;
  return unless $maxUndo;
  return unless ref $undo;
  my $fsfile=$undo->[0];
  $undo=$undo->[1];
  return unless ref $fsfile and ref $undo;
  print "Saving undo: $undo->[4] for file ".$fsfile->filename()."\n" if $tredDebug;

  if ($fsfile != $win->{FSFile}) {
    warn("Undo: window displays a different file than undo was prepared for.\n");
  }
  initAppData($fsfile);

  my $stack=$fsfile->appData('undostack');
  splice @$stack, $fsfile->appData('undo')+1; # remove redo
  push @$stack,$undo;
  if ($maxUndo>0 and @$stack>$maxUndo) {
    splice @$stack, 0, (@$stack-$maxUndo);
    print STDERR "Undo-stack: overflow, removing ",(@$stack-$maxUndo)," items\n" if $tredDebug;
  }
  $fsfile->changeAppData('undo',$#$stack);
  resetUndoStatus($win);
  print STDERR "Undo-stack: $#$stack items\n" if $tredDebug;
}

sub re_do {
  my ($grp_or_win)=@_;
  my $win = cast_to_win($grp_or_win);
  return unless $maxUndo;
  my $fsfile=$win->{FSFile};
  return unless $fsfile;
  my $stack=$fsfile->appData('undostack');
  return unless (@$stack>$fsfile->appData('undo')+2);
  print STDERR "Redo: ",$fsfile->appData('undo')+2,"/$#$stack\n" if $tredDebug;
  $fsfile->changeAppData('undo',$fsfile->appData('undo')+2);
  undo($win,1);
}

sub undo {
  my ($grp_or_win,$redo)=@_;
  my $win = cast_to_win($grp_or_win);
  return unless $maxUndo;
  my $fsfile=$win->{FSFile};
  return unless $fsfile;
  my $stack=$fsfile->appData('undostack');
  my $stackpos=$fsfile->appData('undo');
  return unless (ref($stack) and (@$stack>0) and ($stackpos>=0) and ($stackpos <= $#$stack));
  my $undo=$stack->[$stackpos];
  if ($undo) {
    my $new_undo;
    my $type = $undo->[0];
    $new_undo=prepare_redo($win,$undo)
      if (!$redo and $#$stack == $stackpos);
    my $treeNo=$undo->[1];
    my $snapshot=$undo->[2];
    if ($type eq 'Snapshot') {
      my $what=$undo->[5];
      if ($what == UNDO_ACTIVE_NODE or
	  $what == UNDO_ACTIVE_ROOT or
	  $what == UNDO_DISPLAYED_TREES or
	  $what == UNDO_DATA
	 ) {
	restore_data_from_snapshot($snapshot->[0]);
	# nothing to do
      } elsif ($what == UNDO_CURRENT_TREE) {
	my $prev = $fsfile->treeList->[$treeNo];
	$prev->destroy if ref($prev);
	$fsfile->treeList->[$treeNo] = restore_data_from_snapshot($snapshot->[0]);
      } elsif ($what == UNDO_TREE_ORDER) {
	@{$fsfile->treeList}=@$snapshot;
      } elsif ($what == UNDO_CURRENT_TREE_AND_TREE_ORDER) {
	#	my $prev = $fsfile->treeList->[$treeNo];
	#	$prev->destroy if ref($prev);
	#	$prev=
	restore_data_from_snapshot($snapshot->[0]);
	my %r; @r{ @{$snapshot->[1]} }=();
	for (@{$fsfile->treeList}) {
	  $_->destroy if eval { ref ($_) and !$_->parent and !exists($r{$_}) };
	}
	@{$fsfile->treeList}=@{$snapshot->[1]};
	# $fsfile->treeList->[$treeNo]=$prev;
      } elsif ($what == UNDO_ACTIVE_ROOT_AND_TREE_ORDER or
	       $what == UNDO_DATA_AND_TREE_ORDER) {
	restore_data_from_snapshot($snapshot->[0]);
	my %r; @r{ @{$snapshot->[1]} }=();
	for (@{$fsfile->treeList}) {
	  $_->destroy if eval { ref ($_) and !$_->parent and !exists($r{$_}) };
	}
	@{$fsfile->treeList}=@{$snapshot->[1]};
      } else {
	ErrorMessage($win, "Unknown undo type: $what\n");
      }
    } elsif ($type eq 'FS') {
      my $prev = $fsfile->treeList->[$treeNo];
      $prev->destroy if ref($prev);
      $fsfile->treeList->[$treeNo]=$fsfile->FS->parseFSTree($snapshot);
    } elsif ($type eq 'Storable') {
      my $prev = $fsfile->treeList->[$treeNo];
      $prev->destroy if ref($prev);
      $fsfile->treeList->[$treeNo]=Storable::thaw($snapshot);
    }
    if ($#$stack == $stackpos) {
      if ($redo) {
	pop @$stack;
      } else {
	push @$stack, $new_undo->[1];
      }
    }
    print STDERR "Undo: ",$stackpos."/$#$stack\n" if $tredDebug;
    $fsfile->changeAppData('undo',$fsfile->appData('undo')-1);
    resetUndoStatus($win);
    $fsfile->notSaved(1);
    $win->{treeNo}=$treeNo;
    get_nodes_fsfile_tree($win->{framegroup},$fsfile,$treeNo);
    $win->{currentNode}=ref($undo->[3]) ? $undo->[3] : $win->{Nodes}[$undo->[3]];
    ensureCurrentIsDisplayed($win);
    redraw_fsfile_tree($win->{framegroup},$fsfile,$treeNo);
    centerTo($win,$win->{currentNode});
  } else {
    errorMessage($win,"Corrupted undo stack!");
  }
}

sub resetUndoStatus {
  my ($win)=@_;
  my $fsfile=$win->{FSFile};
  my $grp = $win->{framegroup};
  my ($undostatus,$redostatus,$undomessage,$redomessage);

  if ($maxUndo!=0 and ref($fsfile)) {
    my $stack=$fsfile->appData('undostack');
    my $stackpos=$fsfile->appData('undo');
    print STDERR "UNDO_STACK: $stackpos/",$#$stack+1,"\n" if $tredDebug;
    $undostatus=(ref($stack) && (@$stack>0));
    $redostatus=($undostatus && (@$stack>$stackpos+2));
    $undostatus &&= (($stackpos>=0) && ($stackpos <= $#$stack));
    $undomessage = ": ".$stack->[$stackpos]->[4] if ($undostatus);
    $redomessage = ": ".$stack->[$stackpos+1]->[4] if ($redostatus);
  } else {
    $undostatus=0;
    $redostatus=0;
  }
  if ($grp->{undoButton}) {
    $grp->{undoButton}->
      configure(-state => ($undostatus ? 'normal' : 'disabled'));
    $grp->{Balloon}->attach($grp->{undoButton},
			    -balloonmsg=> "Undo".$undomessage);
  }
  if ($grp->{redoButton}) {
    $grp->{redoButton}->
      configure(-state => ($redostatus ? 'normal' : 'disabled'));
    $grp->{Balloon}->attach($grp->{redoButton},
			    -balloonmsg=> "Redo".$redomessage);
  }
}

sub resetTreePosStatus {
  my ($grp)=@_;
  my $win=$grp->{focusedWindow};
  my $fsfile=$win->{FSFile};

  my $prevstatus=ref($fsfile) && $fsfile->lastTreeNo>=0 && $win->{treeNo}>0;
  my $nextstatus=ref($fsfile) && $fsfile->lastTreeNo>$win->{treeNo};
  if ($win->{framegroup}->{nextButton}) {
    $win->{framegroup}->{nextButton}->
      configure(-state => ($nextstatus ? 'normal' : 'disabled'));
  }
  if ($win->{framegroup}->{prevButton}) {
    $win->{framegroup}->{prevButton}->
      configure(-state => ($prevstatus ? 'normal' : 'disabled'));
  }
}


sub list_isearch {
  my ($w)=@_;
  my $e= $w->XEvent;
  my $A= $e->A;
  if ($A ne EMPTY) {
    my @items=$w->get(0,'end');
    my $count=$w->index('end');
    my $active=$w->index('active');
    for (my $i=$active+1;$i<=$active+$count;$i++) {
      if ($items[$i % $count] =~ /^$A/i) {
	$w->activate($i % $count);
	unless ($w->isa('Tk::Listbox') and
	    $w->cget('-selectmode') eq 'multiple' or
	    $w->cget('-selectmode') eq 'extended') {
	  $w->selectionClear(0,'end');
	  $w->selectionSet($i % $count);
	}
	$w->see($i % $count);
	Tk->break;
	return;
      }
    }
  }
}

sub cleanup_tredmacro {
  my ($grp)=@_;
  $TrEd::Macros::macrosEvaluated=0;
  # cleanup
  %TrEd::Macros::defines=(TRED => 1);
  my %packages;
  @packages { ('TredMacro',
	       grep {/\S/} grep { !/^main$|^TrEd::/ }
	       map  { (/^\s*package\s+([^;\s]+)\s*;/) } (@TrEd::Macros::macros))
	    } = ();
  my %kept_pkg;
  my %deleted_pkg;
  foreach my $package ( sort { length($b)<=>length($a) } keys %packages ) {
    no strict qw(refs);
    print STDERR ("Cleaning package $package\n") if $tredDebug;
    my $pkg_file = $package;
    $pkg_file =~ s{::}{/}g;
    $pkg_file .= '.pm';
    delete ${$package.'::'}{$_} foreach grep !/::$/, keys %{$package.'::'};
    undef @kept_pkg{ map $package.'::'.$_, keys %{$package.'::'} } if %{$package.'::'};
    undef $deleted_pkg{$package.'::'};
    delete $INC{$pkg_file};
    eval("package $package; use UNIVERSAL qw(isa can);");
    print STDERR $@ if $@;
  }
  print STDERR "KEPT: @{[join qq(\n\t),keys %kept_pkg]}.\n",
    "DELETED: @{[join qq(\n\t),keys %deleted_pkg]}\n"
      if $tredDebug;
}

sub declareMinorMode {
  my ($grp_or_win,$name,$opts) = @_;
  my ($grp,$win)=grp_win($grp_or_win);
  if (exists $grp->{minorModes}{$name}) {
    carp("WARNING: re-declaration of an existing minor context $name");
  }
  $grp->{minorModes}{$name}=$opts;
  for my $type (qw(pre post)) {
    my $hooks = $opts->{$type.'_hooks'};
    if (ref($hooks) eq 'HASH') {
      foreach my $hook (keys %$hooks) {
	$grp->{'minor'.ucfirst($type).'Hooks'}{$hook}{$name}=$hooks->{$hook};
      }
    }
  }
  for my $tp ([qw(bindings minorKeyBindings)],
	      [qw(priority_bindings minorKeyPriorityBindings)]) {
    my ($type,$store) = @$tp;
    if (ref($opts->{$type}) eq 'ARRAY') {
      for my $binding (@{$opts->{$type}}) {
	my $key = $binding->{key};
	my $macro = $binding->{command};
	if (defined($key) and defined($macro)) {
	  $grp->{$store}{$name}{$key}=$macro;
	}
      }
    } elsif (ref($opts->{$type}) eq 'HASH') {
      $grp->{$store}{$name}=$opts->{$type};
    }
  }
  update_minor_modes($grp);
}
sub enableMinorMode {
  my ($grp_or_win,$name)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  if (ref($win->{minorModes})) {
    if (!first { $_ eq $name } @{$win->{minorModes}}) {
      push @{$win->{minorModes}}, $name;
    }
  } else {
    $win->{minorModes}=[$name];
  }
  update_minor_modes($win);
}
sub disableMinorMode {
  my ($grp_or_win,$name)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  if (ref($win->{minorModes})) {
    @{$win->{minorModes}}=grep {$_ ne $name} @{$win->{minorModes}};
  }
  update_minor_modes($win);
}
sub toggleMinorMode {
  my ($grp_or_win,$name)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  if (ref($win->{minorModes})) {
    if (first { $_ eq $name } @{$win->{minorModes}}) {
      disableMinorMode($grp_or_win,$name);
    } else {
      enableMinorMode($grp_or_win,$name);
    }
  } else {
    enableMinorMode($grp_or_win,$name);
  }
  get_nodes_win($win);
  redraw_win($win);
  ensureCurrentIsDisplayed($win);
  centerTo($win,$win->{currentNode});
}

sub _minor_ctxt_abbrev {
  my ($grp,$name)=@_;
#  $name=~s/[aeiouy]//gi;
#  return $name;
  return $grp->{minorModes}{$name}{abbrev}
    || join '',$name=~m/(?:^|(?<=_|\s|-))(.)/g;
}
sub configure_minor_mode {
  my ($l,$grp,$name)=@_;
  my $cmd = $grp->{minorModes}{$name}{configure};
  doEvalMacro($grp->{focusedWindow},$cmd) if $cmd;
}
sub update_minor_modes {
  my ($grp_or_win)=@_;
  my ($grp,$win)=grp_win($grp_or_win);
  if ($grp_or_win == $grp and $grp->{minorModesMenu}) {
    update_minor_mode_menu($grp, $grp->{minorModesMenu}->cget('-menu'),0);
    update_minor_mode_menu($grp, $grp->{MinorModesMainMenu},1);
  }
  if ($grp->{focusedWindow}==$win) {
    my %activate = map {$_=>1} @{$win->{minorModes}};
    for my $name (keys %{$grp->{minorModesLabels}}) {
      unless (delete $activate{$name}) {
	my $l = delete $grp->{minorModesLabels}{$name};
	$l->packForget;
	$l->destroy;
      }
    }
    for my $name (grep $activate{$_},@{$win->{minorModes}}) {
      my $l = $grp->{minorModesLabels}{$name} =
	$grp->{minorModesLabelFrame}->Label(
	  -text=>_minor_ctxt_abbrev($grp,$name).' ',
	  -activeforeground=>'darkblue',
	  -highlightcolor=>'blue',
	 )->pack(-side=>'right');
      $l->bind('<Double-1>',[\&configure_minor_mode,$grp,$name]);
      if ($grp->{minorModes}{$name}{configure}) {
	$grp->{Balloon}->attach($l,
				-balloonmsg=> "Double-click to configure '$name'");

	$l->bind('<Enter>',[qw(configure -state active)]);
	$l->bind('<Leave>',[qw(configure -state normal)]);
      }
    }
    my $enabled = $grp->{enabledMinorModesMenu} ||= {};
    if (ref $win->{minorModes}) {
      $enabled->{$_}=0 for grep !$activate{$_}, keys %$enabled;
      $enabled->{$_}=1 for @{$win->{minorModes}};
    }
  }
}

sub update_minor_mode_menu {
  my ($grp,$menu,$checkbuttons)=@_;
  return unless $menu;
  $menu->delete(0,'end');
  $_->destroy for $menu->children;
  my $i=0;
  foreach my $name (sort keys %{$grp->{minorModes}||{}}) {
    my $nice_name = $name;
    $nice_name=~tr/_/ /;
    if ($checkbuttons) {
      $menu->checkbutton(-label => "$nice_name ("._minor_ctxt_abbrev($grp,$name).")",
			 -variable => \$grp->{enabledMinorModesMenu}{$name},
			 -command=> [\&toggleMinorMode,$grp,$name]);
    } else {
      $menu->command(-label => _minor_ctxt_abbrev($grp,$name).":  $nice_name",
		     -command=> [\&toggleMinorMode,$grp,$name]);
    }
  }
}

sub valueLineClick {
  my ($w,$grp,$modif,$but)=@_;
  my $Ev=$w->XEvent;
  my $win=$grp->{focusedWindow};
  my (@tags)=
    $w->tagNames($w->index($Ev->xy));
  my $ret;
  if ($but eq 'Double-1' and $modif eq '') {
    doEvalHook($win,"value_line_click_hook", $but, $modif, \@tags);
    $ret = doEvalHook($win,"value_line_doubleclick_hook", @tags);
    if (ref($ret) and UNIVERSAL::DOES::does($ret,'Treex::PML::Node')) {
      setCurrent($win,$ret);
      ensureCurrentIsDisplayed($win);
      centerTo($win,$ret);
      Tk->break;
      return;
    } elsif ($ret ne 'stop') {
      my %nodes = map { $_=>$_ } @{ $win->{Nodes} };
      for my $t (reverse @tags) {
#	print STDERR "tag: $t\n";
	if (exists $nodes{$t}) {
	#  print STDERR "found $t\n";
	  my $node = $nodes{$t};
	  setCurrent($win,$node);
	  ensureCurrentIsDisplayed($win);
	  centerTo($win,$node);
	  Tk->break;
	  return;
	}
      }
      # fallback
      my $node=$win->{root};
      while ($node) {
	if (index(join(EMPTY,@tags),${node})>=0) {
	  setCurrent($win,$node);
	  ensureCurrentIsDisplayed($win);
	  centerTo($win,$node);
	  Tk->break;
	  return;
	}
	$node=$node->following();
      }
    }
  } else {
    doEvalHook($win,"value_line_click_hook", $but, $modif, \@tags);
  }
  Tk->break;
}

sub prepareExtensions {
  my $extensions = getExtensionList();
  my $pre_installed =  getPreInstalledExtensionList($extensions);

  my (%e,%d);
  @e{ split /,/,$enable_extensions }=();
  @d{ split /,/,$disable_extensions }=();

#   if (defined $opt_m) {
#     warn("Using -m implies all extensions disabled...\n") unless $opt_q;
#  }

  @$extensions =
    map { /^!(.*)/ ?
	    (exists($e{'*'}) && !exists($d{$1}) || exists($e{$1}) ? $1 : $_)
	      : $opt_m ?
		(exists($e{'*'}) && !exists($d{$_}) || exists($e{$_}) ? $_ : '!'.$_)
		  : (exists($d{'*'}) && !exists($e{$_}) || exists($d{$_}) ? '!'.$_ : $_)
		} @$extensions;

  @$pre_installed =
      map { /^!(.*)/ ?
	      (exists($e{'*'}) && !exists($d{$1}) || exists($e{$1}) ? $1 : $_)
		: $opt_m ?
		  (exists($e{'*'}) && !exists($d{$_}) || exists($e{$_}) ? $_ : '!'.$_)
		    : (exists($d{'*'}) && !exists($e{$_})|| exists($d{$_}) ? '!'.$_ : $_)
		  } @$pre_installed;
  my %have; @have{@$extensions,@$pre_installed}=();
  for my $required (keys %e) {
    if ($required ne '*' and !exists($have{$required})) {
      warn("WARNING: extension $required not found!");
    }
  }
  initExtensions($extensions);
  initExtensions($pre_installed, getPreInstalledExtensionsDir());
  return [$extensions,$pre_installed];
}

sub loadMacros {
  my ($grp,$opts)=@_;
  $opts||={};
  read_macros($macroFile,$libDir); # read macros

  my $preinst_dir = getPreInstalledExtensionsDir();

  my ($extensions,$pre_installed);
  if (ref($opts->{preparedExtensions})) {
    ($extensions,$pre_installed)=@{$opts->{preparedExtensions}}
  } else {
    ($extensions,$pre_installed)=@{ prepareExtensions() };
  }

  foreach my $path (getExtensionSampleDataPaths($extensions),
		    getExtensionSampleDataPaths($pre_installed,$preinst_dir)) {
    foreach my $f (glob(File::Spec->catfile($path,'*.fl'))) {
      print "Reading $f\n" if $tredDebug;
      my $fl=Filelist->new(undef,$f);
      next unless $fl;
      print STDERR "Reading filelist ".$fl->filename."\n" if $tredDebug;
      eval {
	$fl->load();
	addNewFilelist(undef,$fl);
      };
      if ($@) {
	warn $@;
      } else {
	$filelist_from_extension{$fl}=1;
      }
    }
  }

  print STDERR ("Reading extension macros:") unless $opt_q;
  for my $ext_contrib (getExtensionMacroPaths($extensions),
		       getExtensionMacroPaths($pre_installed,$preinst_dir)) {
    
    if (-f $ext_contrib) {
      if ($tredDebug) {
	print STDERR ("Reading extension macros from $ext_contrib...\n");
      } elsif (!$opt_q) {
	my $name = $ext_contrib;
	$name=~s{.*/extensions/([^/]+)/contrib.*}{$1};
	print STDERR (" $name");
      }
      push @TrEd::Macros::macros,qq(\n#line 0 "$ext_contrib"\n{\npackage TredMacro;\n);
      read_macros($ext_contrib,$libDir,1);
      push @TrEd::Macros::macros,qq(\n} # end of "$ext_contrib"\n);
    }
  }
  print STDERR " ... done\n" if !$opt_q and !$tredDebug;
  if ($opt_I) {
    print STDERR ("Reading additional macros from $opt_I...") unless $opt_q;
    push @TrEd::Macros::macros,qq(\n#line 0 "$opt_I"\n{\npackage TredMacro;\n);
    read_macros($opt_I,$libDir,1);
    push @TrEd::Macros::macros,qq(\n} # end of "$opt_I"\n);
    print STDERR "done.\n" unless $opt_q;
  }

}

sub reloadMacros {
  my ($grp,$opts)=@_;
  doEvalHook($grp->{focusedWindow},"reload_macros_hook");
  delete $grp->{minorModes};
  delete $grp->{minorPreHooks};
  delete $grp->{minorPostHooks};
  %keyBindings=();
  %menuBindings=();
  TrEd::TreeView->clear_code_caches;
  cleanup_tredmacro($grp);
  for my $name (keys %{$grp->{UserToolbarHash}}) {
    my $tb = removeUserToolbar($grp,$name);
    if ($tb) {
      $tb->packForget;
      $tb->destroy;
    }
  }
  %{$grp->{UserToolbarHash}}=();
  loadMacros($grp,$opts);
  doEvalHook($grp->{focusedWindow},"macros_reloaded_hook");
  doEvalHook($grp->{focusedWindow},"initialize_bindings_hook");

  update_macro_menus($grp);
  update_macrolist_view($grp);
  get_nodes_all($grp);
  redraw_all($grp);
}

sub manage_extensions {
  my ($grp,$do_reload) = @_;
  my $reload_macros;
  my $repos = [ split /\s+/, $extensionRepos ];
  manageExtensions($grp, {
    repositories => $repos,
    reload_macros => \$reload_macros,
  });
  my $new = $extensionRepos;
  $new = join ' ', @$repos;
  if ($new=~/\S/ and $new ne $extensionRepos) {
    $extensionRepos=$new;
    saveRuntimeConfig($grp,{
      extensionRepos => $extensionRepos,
    });
  }
  if ($do_reload and $reload_macros) {

    # reload stylesheets
    @TrEd::Utils::stylesheetPaths=();
    initStylesheetPaths([split($Treex::PML::resourcePathSplit,$opt_S,-1)]);

    my $preparedExtensions = prepareExtensions($grp);

    loadStyleSheets($grp);
    updateStylesheetMenu($grp);
    updateHelpMenu($grp,{preparedExtensions => $preparedExtensions});
    
    # reload macros
    reloadMacros($grp,{preparedExtensions => $preparedExtensions});
  }
}

sub loadStdFilelists {
  my $dir = File::Spec->catdir($tred_d,'filelists');
  return unless -d $dir;
  my %name = map { $_->name => $_ } @filelists;
  for my $f (glob(File::Spec->catfile($dir,'*'))) {
    my $name = filename($f);
    $name =~ s/\.fl$//i; # strip .fl suffix if any
    my $uname = Encode::decode('UTF-8',URI::Escape::uri_unescape($name));
    if (URI::Escape::uri_escape_utf8($uname) ne $name) {
      my $nf = File::Spec->catfile($dir,URI::Escape::uri_escape_utf8($uname));
      if (rename $f, $nf) {  # rename unescaped version if exists
	$f = $nf;
	print STDERR "renaming\n $f\n  to\n $nf\n" if $tredDebug;
      } else {
	warn "Failed to rename $f to $nf\n";
      }
    }
    $name = $uname;
    if (exists $name{$name}) {
      warn("Ignoring filelist $f, filelist named $name already loaded from ",$name{$name}->filename,"\n");
    } else {
      my $fl=Filelist->new($name,$f);
      if ($fl) {
	print STDERR "Reading filelist ".$fl->filename."\n" if $tredDebug;
	eval {
	  $fl->load();
	  addNewFilelist(undef,$fl);
	};
	if ($@) {
	  warn $@;
	} else {
	  $filelist_from_extension{$fl}=2;
	}
      }
    }
  }
}

sub saveStdFilelist {
  my ($fl)=@_;
  my $dir = File::Spec->catdir($tred_d,'filelists');
  mkdir $dir unless -d $dir;
  my $name = $fl->name;
  $name = URI::Escape::uri_escape_utf8($name);
  if (defined $name and length $name) {
    $fl->filename(File::Spec->catdir($dir,$name));
    $fl->save;
  }
}

__END__

=head1 NAME

TrEd - a graphical visualizer and editor of tree graphs

=head1 SYNOPSIS

 tred [-q] [-c <config-file>] [-m|-I <macro-file>] [-t context]
      [-l <filelist>] [-n encoding] [other-options] [file[##N|##N.M|#ID] ...]

or

  tred -C <command>

or

  tred -u          for usage
  tred -h          for help
  tred --man       for the manual page
  tred --version   for version

=head1 DESCRIPTION

TrEd is a graphical visualizer and editor of tree graphs.

=head2 Filename arguments

Each filename on the command-line or in a file list may be optionally
followed by a suffix which identifies a node to be selected when the
file is opened.  The suffix can be of one of the following following
forms:

#ID     where ID is an identifier of a node (for file formats that have
        identifiers, e.g. PML).

##N     where N is a number. This selects the root of the N-th tree

##N.M   where N and M are numbers. This selects the M-th node in 
        the depth-first order in the N-th tree.

=head2 Options

=over 8

=item B<-C> command

Perform a given command on a running instance of TrEd.
Currently only one command is supported:

  open <filename>

If there is no TrEd instance running, the filename is opened in a new
instance.

=item B<--filelist|-l> filename

Read a list of filenames to process from a given file (one filename
per line). Files specified in a file-list are processed prior to files
specified on the command-line. If file-list is a file with .fl
extension, then the first line may contain a file-list name (as in
TrEd). Moreover, unlike in other file-lists, filenames in .fl
file-lists are asssumed to be relative to the file-list file location.

=item B<--macro-file|-m> filename

File with macro definitions to load.  If no macro-file is given,
standard macro file (by default F<tred.mac>) is used.

=item B<--include-macro-file|-I> filename

A file containing additional set of macros to load. This option is
typically used instead of C<--macro-file> to allow loading macros
B<both> from C<filename> B<and> the default macro set (F<tred.mac>).
C<--macro-file> can still be used in combination with
B<--include-macro-file> to supply a replacement for F<tred.mac>.

=item B<--config-file|-c> filename

TrEd configuration file (overrides ~/.tredrc).

=item B<--option|-O> name=value

Override configuration option from the config file with a given
value. This flag can be used several times for different options.

Special syntax of the name part allows some modifications of existing
option values for options that are delimited lists (this cannot be
used to modify default or implicit values):

=over 8

=item nameX=value

Treat the option as a list delimited by the delimiter X and
prepend the value to the list.

=item  nameX+=value

Treat the option as a list delimited by the delimiter X and append the
value to the list.

=item  nameX-=value

Treat the option as a list delimited by the delimiter X and remove the
value from the list (if exists).

=back

Only the following characters can be used as a delimiter:

      ; : , & | / + - \s \t SPACE

where SPACE is a space character, \s matches arbitrary white-space,
and \t matches TAB character.

The options can be combined; for example

  -O "extensionRepos\\s"-=http://foo/bar -O "extensionRepos\\s"+=http://foo/bar

first removes any occurrence of the URL http://foo/bar from the
white-space separated list of extensionRepos and then appends the URL
to the end of the list.

=item B<--stylesheet-file> path

Path may be either a file name, in which case it must point to a TrEd
stylesheet configuration file in the old format or ~/.tred-stylesheets
(obsolete), or a directory, in which case each file in the directory
must be a TrEd stylesheet.

=item B<--resource-dir|-Z> dirnames

Specifies resource path. This option can be repeated and overrides
ResoucePath setting in the TrEd configuration file. 

Individual paths can also be separated by colon (POSIX/Unix) or
semi-colon (Windows) separator. If there is a lone leading or trailing
separator, the default resource path is prepended or appended,
respectively.

=item B<--context|-t> context_name

Initial macro context.

=item B<--show-hidden-nodes|-H> 

Start in the mode where hidden nodes are displayed.

=item B<--stylesheet|-s> stylesheet-name

Initial stylesheet to render the tree according to.

=item B<--split-window|-p> number

Split window to given number of subwindows (horizontally if
positive, vertically if negative) and open n'th file
in n'th subwindow.

=item B<--execute|-e> perl-code

Macro code to evaluate just before the main loop is started.

=item B<--window-embed|-W> window_ID

Embed main window into window with the given window ID.

=item B<--no-geometry|-G>

Do not initially resize window to its last geomtery.

=item B<--extra-backends|-B> backend

Comma separated list of user-defined IO-backend modules to load.

=item B<--file-encoding|-n> encoding

Allows to specify character encoding of input files (does not apply to
XML files).

=item B<--define-symbol> symbol_name

Symbol name or a name=value pair to be used by macro-preprocessor
(equivalent to a C<#define> instruction at the beginning of the macro
file). Multiple definitions symbols may be separated by a comma and
the option may be repeated.

=item B<--no-secondary-files|-Y>

Neither load or save "secondary" files. Normally, secondary files (if
loaded) are saved along with their primary files (the exactly same
file-name prefix/suffix processing and format apply to both the
primary and secondary files). A secondary file is a file required by a
(normal - primary) file to be loaded along with it; this is typical
for files containing some form of a stand-off annotation where one
tree is built upon another. Note however, that this does not include so
called knitting - an operation where the stand-off annotation is
handled by a IO backend and the resulting knitted file appears to
btred as a single unit.

=item B<--enable-extensions|-j> list

Give a comma-separated list of installed TrEd extension names to
temporarily enable if disabled in the extension configuration.
Use '*' to enable all currently enabled extensions.

=item B<--disable-extensions|-J> list

Give a comma-separated list of installed TrEd extension names to
temporarily disable if enabled in the extension configuration.
Use '*' to disable all currently enabled extensions.

=item B<--tectogrammatical-trees|-R>

Build tectogrammatic trees from CSTS files.

=item B<--csts-tree-attributes|-X> gov,ord?,hide?

CSTS format is "many in one"; there may be more tree structures in one
file.  This option can be used to specify which tree structure should
be used.  Provide a comma separated list consisting of names of node
atributes corresponding to CSTS elements that contain the necessary
information to build a tree out of a CSTS file. The first attribute
should be an attribute containing the index of the governing node; the
second one is optional and specifies the ordering attribute; the third
one is also optional and if specified, it should be the attribute used
to mark hidden nodes with the string 'hide'. If the third argument is
specified as empty (i.e. there is a trailing comma), default to
'X_hide' with preset-value 'hide'. 

Examples: 
  -X govTR,dord  - corresponds to elements <TRg> and <tfr>
                   in CSTS

  -X govMD_c,ord,x_MD_c_hide 
                 - corresponds to <MDg src="c">, <r>, 
                   and <x name="MD_c_hide">).

=item B<--no-backups>

Do not generate `tilda' backup files.

=item B<--no-locks>

Do not attempt to create lock files. Lock files are used to prevent
another TrEd instance/user from modifying the same document.

=item B<--autosave> number

Create an auto-save file for each modified document every given number
of minutes. If 0, auto-saving is disabled.

=item B<--quiet|-q>

Print only general processing information on stderr.

=item B<--debugging|-D>

Print a lot of debugging information on the stderr.

=item B<--carp>

Replace 'die' with 'Carp::confess', so that a complete stack trace is
printed upon error. Useful for debugging.

=item B<--version|-v>

Print version and quit.

=item B<--man|-m>

Displays the help as manual page.

=item B<--help|-h>

Prints the help page and exits.

=item B<--usage|-u>

Print a brief help message on usage and exits.

=back

=head1 SEE ALSO

TrEd User Manual at http://ufal.mff.cuni.cz/~pajas/tred/ar01-toc.html
(also located in the documentation directory in the installation of
TrEd).

=head1 LICENSE

This software is distributed under GPL - The General Public Licence.
Full text of the GPL can be found in the LICENSE file distributed with
this program and also on-line at http://www.gnu.org/copyleft/gpl.html .

=head1 AUTHOR

Petr Pajas <pajas@matfyz.cz>

Copyright 2000-2008 Petr Pajas.

=cut

