#!/usr/bin/perl 
######################################################################
## Athena: graphical data processing using ifeffit
##
##                      Athena is copyright (c) 2001-2008 Bruce Ravel
##                                              bravel AT bnl DOT gov
##                                  http://cars9.uchicago.edu/~ravel/
##
##                   Ifeffit is copyright (c) 1992-2007 Matt Newville
##                              newville AT cars DOT uchicago DOT edu
##                       http://cars9.uchicago.edu/~newville/ifeffit/
##
##	  The latest version of Athena can always be found at
##	       http://cars9.uchicago.edu/~ravel/software/
##
## -------------------------------------------------------------------
##     All rights reserved. This program is free software; you can
##     redistribute it and/or modify it provided that the above notice
##     of copyright, these terms of use, and the disclaimer of
##     warranty below appear in the source code and documentation, and
##     that none of the names of The Naval Research Laboratory, The
##     University of Chicago, University of Washington, or the authors
##     appear in advertising or endorsement of works derived from this
##     software without specific prior written permission from all
##     parties.
##
##     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
##     EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
##     OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
##     NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
##     HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
##     WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
##     FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
##     OTHER DEALINGS IN THIS SOFTWARE.
## -------------------------------------------------------------------
######################################################################
##
## Just as Phaeacian men excel the world at sailing, driving their
## swift ships on the open seas, so the women excel at all the arts of
## weaving. That is Athena's gift to them beyond all others -- a
## genius for lovely work, and a fine mind too.
##
##                                          Homer, The Odyssey, Book 7
##
######################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2010 Bruce Ravel
##



BEGIN {
  ##   ## make sure the pgplot environment is sane...
  ##   ## these defaults assume that the pgplot rpm was installed
  ##   $ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
  ##   $ENV{PGPLOT_DEV} ||= '/XSERVE';

  use Tk;
  die "Athena requires Tk version 800.022 or later\n"  if ($Tk::VERSION < 800.022);
  #require Ifeffit;
  #die "Athena requires Ifeffit.pm version 1.2 or later\n" if ($Ifeffit::VERSION < 1.2);
  #import Ifeffit qw/ifeffit get_array put_array/;
  use Ifeffit qw(ifeffit get_array put_array);
  ifeffit("\&screen_echo = 0\n");
};

use strict;
use warnings;
#use diagnostics;
#use Config;
## need to explicitly state all Tk modules used for the sake of PAR
use Tk::widgets qw(Wm FileSelect FBox Frame NoteBook FileDialog Checkbutton
                   Menu Menu/Item Menubutton Canvas Radiobutton Text Balloon
		   Optionmenu Bitmap Dialog ROText TextUndo Pane Entry Label
		   FireButton NumEntryPlain NumEntry LabFrame
		   Pod Pod/Text Pod/Search Pod/Tree More DirTree
		   Splashscreen Photo waitVariableX ColorEditor
		   KeyEntry RetEntry BrowseEntry HList DialogBox);
### wtf?!?!  PerlApp needs these lines:
use Tk::Pod;
use Tk::TextUndo;
use Tk::FileDialog;

use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Chemistry::Elements qw(get_Z get_symbol);
use Chemistry::Formula qw(parse_formula);
use Config::IniFiles;
use Compress::Zlib;
use Cwd;
use Data::Dumper;
use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use Ifeffit::Files;
use Ifeffit::Group;
use Ifeffit::Tools;
use Math::Combinatorics;
use Safe;
use Spreadsheet::WriteExcel;
use Text::Glob qw(glob_to_regex);
use Text::Wrap;
use Tie::IxHash;
use Time::Stopwatch;
use Xray::FluorescenceEXAFS;

use constant PI    => 3.14159265358979323844;
use constant HBARC => 1973.27053324;
use constant EPSI  => 0.00001;
use constant ETOK  => 0.262468292;

$Data::Dumper::Indent = 0;


my $is_windows = (($^O eq 'MSWin32') or ($^O eq 'cygwin'));
my $is_darwin  = (lc($^O) eq 'darwin');
my $always_false = 0;


my $absorption_exists = (eval "require Xray::Absorption");
($absorption_exists) and eval "require Ifeffit::Elements";
my $lwp_exists = (eval "require LWP::Simple;");
import LWP::Simple if $lwp_exists;

## use Text::Abbrev;
## my $abbrev_table;
## &make_abbrev_table;

my %groups    = ();		# linked hashes connecting groups,
my %menus     = ();		# parameters, and widgets
my %marked    = ();
my %header    = ();
my %grab      = ();
my %plotcard  = ();
my $list;
my $plotsel;
my $last_plot = "";
my $last_plot_params;
my @indicator;
my %pointfinder;
my %old_cols;
my @echo_history = ();
## history buffers for use with get_string
my @regex_history = ();   # mark_regex buffer
my @rename_history = ();  # rename group buffer
my $colsel_geometry = "";
$| = 1;
my @done = (" ... done!", 1);
my $current = 0;
my $current_group;
my $current_file = "";
my $current_data_dir = Cwd::cwd || $ENV{IFEFFIT_DIR} || $ENV{HOME};
my $project_name = "";
my $VERSION = "0.8.061";
my $mouse_over_cursor = 'mouse';
## need to know if the version of ifeffit is current enough to have the
## sort argument to read_data
my $ifeffit_version = (split(" ", Ifeffit::get_string("\$&build")))[0];
my $echo_pause = 150; # time in miliseconds to pause before echoing
my %key_data;
&set_key_data;

my $prior_string = "";
my $prior_args = {old	      => "",
		  numerator   => "",
		  denominator => "",
		  do_ln	      => "",
		  invert      => "",
		  space	      => "",
		  evkev	      => "",
		  is_xmudat   => "",
		  sort	      => "",
		  multi	      => "",
		  ref	      => "",
		  sorted      => ""
		 };

my $vstr = Ifeffit::Tools->vstr;
my $sort_available = ($vstr > 1.0066);
if ($vstr < 1.0076) {
  my $top = MainWindow->new();
  $top -> withdraw();
  my $message = "This version of Athena requires Ifeffit 1.0076 or later.

You can get the latest Ifeffit from http://cars.uchicago.edu/ifeffit.

If you have recently upgraded Ifeffit, you should also rebuild Athena and Artemis.
";
  my $dialog =
    $top -> Dialog(-bitmap         => 'error',
		   -text           => $message,
		   -title          => 'Athena: Exiting...',
		   -buttons        => [qw/OK/],
		   -default_button => 'OK');
  my $response = $dialog->Show();
  exit;
};

unless ($VERSION eq $Ifeffit::Group::VERSION) {
  my $top = MainWindow->new();
  $top -> withdraw();
  my $grouppm = $INC{'Ifeffit/Group.pm'};
  my $message = "Athena appears to be installed incorrectly.

The main program and the Ifeffit/Group.pm module have different version numbers.

main program: $0
Group.pm: $grouppm
";
  my $dialog =
    $top -> Dialog(-bitmap         => 'error',
		   -text           => $message,
		   -title          => 'Athena: Exiting...',
		   -buttons        => [qw/OK/],
		   -default_button => 'OK');
  my $response = $dialog->Show();
  exit;
};
my $About = "Athena $VERSION   2001-2009 Bruce Ravel  <bravel\@bnl.gov>  NO warranty, see license for details";




## global variables for setup and accessing Ifeffit::Group methods
my $line_count = -2; # set this to -1 if "Default Parameters" is included
my $group_count = 0;
my $setup = Ifeffit::Group -> new(line=>$line_count, file=>"");
my $dmode = 5;
## ==== DEBUG =====
## $dmode += 16;
## $dmode += 32;
## ==== DEBUG =====
my $use_default = 0;

## Turn this on to see the demonstration of adding a new analysis mode
## to Athena.  This will put an entry in the Analysis menu labeled
## "Foobaricate"
my $demo_page = 0;

## a couple of global variables to facilitate changing between
## different data analysis views.  these are set when a view is
## displayed and unset when the normal view returns
my $fat_showing = 'normal';	# the currently displayed view
my $which_showing;
my $hash_pointer;		# a pointer to an array of parameters
                                #  needed to make the plot specific to
                                #  the current view

## global variables for keeping track of current state
my $reading_project = 0;
my $project_saved = 1;
my %preprocess = (standard=>'None', standard_lab=>'None', ok => 0,
		  deg_do => 0, trun_do => 0, trun_beforeafter => 'after',
		  int_do => 0, al_do => 0, par_do=>0, mark_do=>0);
my %lcf_data = ();
my %mee_energies = ();

## the maximum amount of heap space in Ifeffit as we begin our work.
## This will be used in the memory check each time a group is read in.
my $max_heap = Ifeffit::get_scalar("\&heap_free") || -1;


use vars qw/@ifeffit_buffer @macro_buffer/;
@ifeffit_buffer = ();
@macro_buffer   = ();

$groups{"Default Parameters"} = Ifeffit::Group -> new(line=>$line_count, file=>"",
						      group=>"Default Parameters");


## set up main window and post splashscreen
my $top = MainWindow->new(-class=>'horae');
$top -> withdraw;
$top -> optionAdd('*font', 'Helvetica 14 bold');
$top -> optionAdd('*font', 'Helvetica 10 bold');
my $splash_background = 'cornsilk3';
my $splash = $top->Splashscreen(-background => $splash_background);
my $splash_image = $top -> Photo(-file => $groups{"Default Parameters"} -> find('athena', 'logo'));
$splash -> Label(-image=>$splash_image, -background => $splash_background)
  -> pack(qw/-fill both -expand 1 -padx 0 -pady 0 -side left/);
my $splash_frame = $splash -> Frame(-background => $splash_background,)
  -> pack(qw/-fill both -expand 1 -padx 0 -pady 0 -side right/);
$splash_frame -> Label(-text       => "Athena\nversion $VERSION",
		       -background => $splash_background,
		       -width      => 20,
		       -font       => 'Helvetica 14 bold',)
  -> pack(qw/-fill both -expand 1/);
my $splash_status =   $splash_frame -> Label(-text       => q{},
					     -background => $splash_background,
					     -font       => 'Helvetica 10 bold',
					     -justify    => 'left',
					     -borderwidth=> 2,
					     -relief     => 'ridge')
  -> pack(-anchor=>'w', -fill=>'x');
$splash -> Splash;
$top -> update;


## ---------------------------------------------------------------------
## establish .horae space
&Ifeffit::Tools::initialize_horae_space;

## ---------------------------------------------------------------------
## add document location to the Pod path
my $poddir = $groups{"Default Parameters"} -> find('athena', 'augpod');
Tk::Pod->Dir($poddir);

## ---------------------------------------------------------------------
## read configuration files:

splash_message("Importing configuration files");
&convert_config_files;

my (%plot_features, @op_text);
my $dummy_rcfile = $groups{"Default Parameters"} -> find('athena', 'rc_dummy');
open I, ">".$dummy_rcfile; print I "[general]\ndummy_parameter=1\n"; close I;
my $system_rcfile = $groups{"Default Parameters"} -> find('athena', 'rc_sys');
my $personal_rcfile = $groups{"Default Parameters"} -> find('athena', 'rc_personal');
my $personal_version = $groups{"Default Parameters"} -> find('athena', 'version_marker');

## config values hardwired in the code
my %default_config;
tie %default_config, 'Config::IniFiles', ();
&default_rc(\%default_config); # set defaults
my $default_config_ref = tied %default_config;
$default_config_ref -> SetFileName($dummy_rcfile);

## system-wide rc file (but check to see that it exists...
my %system_config;
tie %system_config, 'Config::IniFiles', (-file=>$system_rcfile, -import=>$default_config_ref)
  if -e $system_rcfile;;

## if the user does not have a personal rc file, create one
if ((! -e $personal_rcfile) or (-z $personal_rcfile)) {
  open I, ">".$personal_rcfile;
  print I "[general]\ndummy_parameter=1\n";
  close I;
}
## if the user does not have a personal rc file, create one
if (! -e $personal_version) {
  open V, ">".$personal_version;
  print V "";
  close V;
  open I, ">".$personal_rcfile;
  print I "[general]\ndummy_parameter=1\n";
  close I;
};
my %config;
if (-e $system_rcfile) {	# import system-wide file if it exists
  my $system_config_ref = tied %system_config;
  $system_config_ref -> WriteConfig($dummy_rcfile);
  tie %config, 'Config::IniFiles', (-file=>$personal_rcfile, -import=>$system_config_ref );
  unless (tied %config) {	# crude hack to deal with improper rcfile
    open I, ">".$personal_rcfile;
    print I "[general]\ndummy_parameter=1\n";
    close I;
    tie %config, 'Config::IniFiles', (-file=>$personal_rcfile, -import=>$system_config_ref );
  };
} else {			# else import the default
  tie %config, 'Config::IniFiles', (-file=>$personal_rcfile, -import=>$default_config_ref);
  unless (tied %config) {
    open I, ">".$personal_rcfile;
    print I "[general]\ndummy_parameter=1\n";
    close I;
    tie %config, 'Config::IniFiles', (-file=>$personal_rcfile, -import=>$default_config_ref );
  };
};
delete $config{general}{dummy_parameter};
my $config_ref = tied %config;
## I have trouble keeping config files up to date when I build the
## windows versions.  the dark red and dark purple are really
## illegible on windows!
if ($is_windows) {
  ($config{colors}{single} eq 'red4')       and ($config{colors}{single} = 'red2');
  ($config{colors}{marked} eq 'darkviolet') and ($config{colors}{marked} = 'mediumorchid');
};
$config_ref -> WriteConfig($personal_rcfile);
unlink $dummy_rcfile;


foreach my $fonttype (keys %{ $config{fonts} }) {
  $top -> optionAdd('*font', $config{fonts}{$fonttype});
};
$top -> optionAdd('*font', $config{fonts}{med});

$config{list}{real_x1} = $config{list}{x1} || 0.8;
$config{list}{real_x2} = $config{list}{x2} || 0.85;
$config{list}{real_y}  = $config{list}{y}  || 0.86;

if ($config{general}{listside} eq 'right') {
  $config{general}{fatside}='left';
} else {
  $config{general}{fatside}='right';
};
## a bit of backwards compatibility for 0.8.010 (this can no longer be 'd')
if (lc($config{plot}{e_marked}) !~ /[en]/) {$config{plot}{e_marked} = 'n'};
## a bit of backwards compatibility for 0.8.050 (half changed to fraction)
if (lc($config{bkg}{e0}) eq "half") {$config{bkg}{e0} = 'fraction'};


my %rebin = (do_rebin => 0,
	     emin     => $config{rebin}{emin},
	     emax     => $config{rebin}{emax},
	     pre      => $config{rebin}{pre},
	     xanes    => $config{rebin}{xanes},
	     exafs    => $config{rebin}{exafs},
	     abs      => "");

$config{general}{quit_query} ||= 'No';

map { $plot_features{$_} = $config{plot}{$_} } (keys %{$config{plot}});
$plot_features{suppress_markers} = 0;
$plot_features{linestyle} = "lines";

$Ifeffit::Group::rmax_out = $config{fft}{rmax_out};

foreach (qw(slight weak medium strong rigid)) {
  $groups{"Default Parameters"} -> set_clamp(ucfirst($_), $config{clamp}{$_});
};


splash_message("Importing recent files list");


## ---------------------------------------------------------------------
## open and read most recently used (MRU) file
my $mrufile = $groups{"Default Parameters"} -> find('athena', 'mru');
# touch an empty file if needed
unless (-e $mrufile) {open M, ">".$mrufile; print M "[mru]\n"; close M};
my %mru;
tie %mru, 'Config::IniFiles', ( -file => $mrufile );
foreach my $i (1 .. $config{general}{mru_limit}) {
  exists $mru{mru}{$i} or ($mru{mru}{$i} = "");
};

$current_data_dir = $mru{config}{last_working_directory}
  if ($config{general}{remember_cwd});


splash_message("Importing plot styles");

## ---------------------------------------------------------------------
## plot_styles
unless (-e $groups{"Default Parameters"} -> find('athena', 'plotstyles')) {
  open P, ">".$groups{"Default Parameters"} -> find('athena', 'plotstyles') or die "could not open plst file";
  print P <<EOH
[default]
emin=-200
emax=800
e_mu=m
e_mu0=
e_norm=
e_pre=p
e_post=t
e_der=
e_marked=n
kmin=0
kmax=15
k_marked=1
k_w=2
k_win=0
rmin=0
rmax=6
r_mag=m
r_env=0
r_re=0
r_im=0
r_pha=0
r_win=0
r_marked=rr
qmin=0
qmax=15
q_mag=0
q_env=0
q_re=r
q_im=0
q_win=0
q_marked=qr
EOH
  ;
##   foreach my $k (keys %plot_features) {
##     next unless ($k =~ /^[ekqr](_|ma|mi)/);
##     print P "$k = $plot_features{$k}\n";
##   };
  close P
};
my %plot_styles;
tie %plot_styles, 'Config::IniFiles', (-file=>$groups{"Default Parameters"} -> find('athena', 'plotstyles'));

## ---------------------------------------------------------------------
## establish web download directory
my $webdir = $groups{"Default Parameters"} -> find('other', 'downloads');
my @web_buffer = ();

splash_message("Initializing stash directory");

## ---------------------------------------------------------------------
## establish stash directory
&stash_directory;
my $stash_dir = $groups{"Default Parameters"} -> find('other', 'stash');
my $trapfile = File::Spec->catfile($stash_dir, "ATHENA.TRAP");


my %click_help =
  ('File:'		  => "The file name from which these data were read",
   'Name:'                => "The name used internally in Ifeffit for this group",
   'E0:'		  => "The edge energy of this scan (absolute energy).  This is typically about half-way up the edge.",
   'E shift:'		  => "The energy alignment shift, which is applied to the data before any other processing chores begin",
   'Edge step:'		  => "The height of the edge step, normally found by the background removal but may be set by hand and fixed",
   'Rbkg:'		  => "The R-space cutoff between the background and the data.  Half the first peak distance is a good first stab.",
   'k-weight:'		  => "The k-weight used in the background removal.  1, 2, and 3 are typical values.",
   'arbitrary k-weight:'  => "The k-weight used to plot in k, R, or q when the \"kw\" plot button is checked.",
   'dk:'		  => "The window sill width used in background removal or FT.  1 to 3 inv. Ang is a typical value.",
   'window type:'	  => "The functional form of the Fourier transform window",
   'Pre-edge range:'	  => "The range in energy of the pre-edge line regression (relative units) (typically about -200 to -30 eV)",
   'Normalization range:' => "The range of the post-edge normalization (relative units) (typically 100 eV to near the end of the data)",
   'Normalization order:' => "The order of the polynomial regressed to normalize and flatten the data (1=constant, 2=line, 3=quadratic)",
   'Spline range:'	  => "The range in over which the background spline is fit (typically about 1 inv. Ang. to the end of the data)",
   'k:'			  => "The background spline range in inverse Angstroms.  0 or 1 until the end of the data is typical.",
   'E:'			  => "The background spline range in relative energy.  0 or a few volts above the edge to the end of the data is typical.",
   'k-range:'		  => "The range of the forward Fourier transform in inverse Angstroms.  This should cover the reliable data range.",
   'dr:'		  => "The width of the window sill used in the backwards FT.  A half to one Angstrom is a typical value.",
   'R-range:'		  => "The range of the backward Fourier transform in Angstroms.  This should cover the peaks to back transform.",
   'Standard:'            => "The group to use as a background removal standard (this is usually None or a chi.dat file from Feff)",
   'plot multiplier:'     => "The data in this group will be multiplied by this amount in most plots",
   'y-axis offset:'       => "The amount of vertical displacement when plotting this group",
   'Background:'          => "Choose AUTOBK or Cromer-Liberman for normalizing the data and isolating chi(k)",
   'Z:'                   => "The atomic symbol of the central atom, needed for CL normalization and phase correction",
   'Edge:',               => "The absorption edge of the data, needed for phase corrected Fourier transforms",
   'Phase correction:'    => "Subtract the central atom phase shift from the data before Fourier transforming",
   'Spline clamps:'       => "Restrain the ends of the background spline by clamping to the data",
   'low:'                 => "Apply a clamp to the low end of the background spline (None is the default)",
   'high:'                => "Apply a clamp to the high end of the background spline (Strong is a good default)",
   'Importance:'          => "The weight of this group relative to other groups included in a merge",
   #'Nclamp:'              => "The number of points to include in the clamping restraint",
  );

## command completion in the ifeffit buffer
use Text::Abbrev;
my %abbrevs = abbrev qw(chi_noise color comment cursor def echo erase
			exit feffit ff2chi fftf fftr findee guess
			history load macro minimize newplot path pause
			plot pre_edge print quit read_data rename
			reset restore save set show spline sync
			write_data zoom @all @arrays @commands @group
			@macros @path @scalars @strings @variables );

splash_message("Importing hints file");

my $hint_file = $groups{"Default Parameters"} -> find('athena', 'hints');
my @hints = ();
my $hint_n;
if (-e $hint_file) {
  open HINT, $hint_file or die "could not open hint file $hint_file for reading\n";
  while (<HINT>) {
    next if (/^\s*($|\#)/);
    chomp;
    push @hints, $_;
  };
  srand;
  $hint_n = int(rand $#hints);
  close HINT;
};

## import multi-electron data
my $system_mee = $groups{"Default Parameters"} -> find('athena', 'system_mee');
my $mee_file   = $groups{"Default Parameters"} -> find('athena', 'mee');
copy($system_mee, $mee_file) if (not -e $mee_file);
my %system;
tie %system, 'Config::IniFiles', (-file=>$system_mee);
my $system_ref = tied %system;
tie %mee_energies, 'Config::IniFiles', (-file=>$mee_file, -import=>$system_ref);




## ---------------------------------------------------------------------
# 


splash_message("Creating key bindings");

#$top -> configure(-font		       => $config{fonts}{small});
$top -> setPalette(-font	       => $config{fonts}{small},
		   foreground	       => $config{colors}{foreground},
		   background	       => $config{colors}{background},
		   activeBackground    => $config{colors}{activebackground},
		   disabledForeground  => $config{colors}{disabledforeground},
		   disabledBackground  => $config{colors}{background},
		   highlightColor      => $config{colors}{highlightcolor},
		   -highlightthickness => 4);
$top -> protocol(WM_DELETE_WINDOW => \&quit_athena);
##my $detached_plot = $top -> Toplevel(-title=>'Athena: detached plot buttons', -class=>'horae');
##$detached_plot -> withdraw;
my $replace;
my $b_frame;			# frame to hold plotting buttons

$top -> title('Athena');
$top -> iconname('Athena');
#my $iconbitmap = $groups{"Default Parameters"} -> find('athena', 'xpm');
#$top -> iconbitmap('@'.$iconbitmap);
my $iconimage = $top -> Photo(-file => $groups{"Default Parameters"} -> find('athena', 'xpm'));
$top -> iconimage($iconimage);

$top -> bind('<Control-a>'     => sub{mark('all')});
$top -> bind('<Control-b>'     => \&about_group);
$top -> bind('<Control-B>'     => sub{about_marked_groups(\%marked)});
$top -> bind('<Control-f>'     => sub{freeze('this')});
$top -> bind('<Control-F>'     => sub{freeze('all')});
$top -> bind('<Control-h>'     => \&show_hint);
$top -> bind('<Control-i>'     => sub{mark('toggle')});
$top -> bind('<Control-j>'     => \&current_down);
$top -> bind('<Control-k>'     => \&current_up);
$top -> bind('<Control-l>'     => \&get_new_name);
$top -> bind('<Control-m>'     => sub{pod_display("index.pod")});
$top -> bind('<Control-M>'     => sub{freeze('marked')});
#$top -> bind('<Control-n>'     => sub{mark('none')});
$top -> bind('<Control-o>'     => sub{&read_file(0)});
$top -> bind('<Control-p>'     =>
	     sub{
	       if ($is_windows) {
		 Error("Print from the plotting window instead!");
	       } else {
		 &replot('print');
	       };
	     });
$top -> bind('<Control-q>'     => \&quit_athena);
$top -> bind('<Control-r>'     => sub{mark_regex(1)});
$top -> bind('<Control-R>'     => sub{freeze('regex')});
$top -> bind('<Control-s>'     => sub{&save_project("all quick")});
$top -> bind('<Control-t>'     => sub{mark('this')});
$top -> bind('<Control-T>'     => \&tie_untie_e0);
$top -> bind('<Control-u>'     => sub{mark('none')});
$top -> bind('<Control-U>'     => sub{freeze('none')});
$top -> bind('<Control-w>'     => \&close_project);
$top -> bind('<Control-y>'     => \&copy_group);
$top -> bind('<Control-0>'     => \&clear_project_name);

$top -> bind('<Meta-k>' => \&group_up);
$top -> bind('<Meta-j>' => \&group_down);
$top -> bind('<Alt-k>'  => \&group_up);
$top -> bind('<Alt-j>'  => \&group_down);
if ($Tk::VERSION < 804) {
  $top -> bind('<Meta-o>' => sub{&read_file(1)});
  $top -> bind('<Alt-o>'  => sub{&read_file(1)});
} else {
  $top -> bind('<Meta-o>' => sub{&read_file(0)});
  $top -> bind('<Alt-o>'  => sub{&read_file(0)});
};
$top -> bind('<Meta-d>' => \&Dumpit);
$top -> bind('<Alt-d>'  => \&Dumpit);

$top -> bind('<Control-period>' => \&cursor);
$top -> bind('<Control-slash>'  => \&swap_panels);
$top -> bind('<Control-minus>'  => sub{&replot('replot')});
$top -> bind('<Control-equal>'  => \&zoom);
my $multikey = "";
$top -> bind('<Control-semicolon>' => \&keyboard_plot);
$top -> bind('<Meta-semicolon>'    => \&keyboard_plot_marked);
$top -> bind('<Alt-semicolon>'     => \&keyboard_plot_marked);

## user configured, user defined key sequences (yikes!)
my $user_key = "<Control-" . $config{general}{user_key} . ">";
$top -> bind($user_key => [\&keys_dispatch, 'control']);
$user_key = "<Meta-" . $config{general}{user_key} . ">";
$top -> bind($user_key => [\&keys_dispatch, 'meta']);
$user_key = "<Alt-" . $config{general}{user_key} . ">";
$top -> bind($user_key => [\&keys_dispatch, 'meta']);
## save, so it can be unbound if changed
$user_key = $config{general}{user_key};

## What buttons look like:
my @pluck_button  = (-foreground	 => $config{colors}{highlightcolor},
		     -activeforeground	 => $config{colors}{activehighlightcolor},
		     -disabledforeground => $config{colors}{disabledhighlightcolor},
		     -background	 => $config{colors}{background},
		     -activebackground	 => $config{colors}{activebackground});
my $pluck_bitmap = '#define pluck_width 9
#define pluck_height 9
static unsigned char pluck_bits[] = {
   0x81, 0x01, 0xc3, 0x00, 0x66, 0x00, 0x3c, 0x00, 0x38, 0x00, 0x78, 0x00,
   0xcc, 0x00, 0x86, 0x01, 0x03, 0x01};
';
my $pluck_X = $top -> Bitmap('pluck', -data=>$pluck_bitmap,
			     -foreground=>$config{colors}{activehighlightcolor});
my @pluck=(-image=>$pluck_X);
my @button_list =   (-foreground         => $config{colors}{button},
		     -activeforeground	 => $config{colors}{button},
		     #-font               => $config{fonts}{small},
		     -background	 => $config{colors}{background},
		     -activebackground	 => $config{colors}{activebackground});
my @r_button_list = (-foreground         => $config{colors}{background},
		     -activeforeground	 => $config{colors}{activebackground},
		     -background	 => $config{colors}{button},
		     -activebackground	 => $config{colors}{activebutton},
		     -disabledforeground => $config{colors}{disabledforeground});
my @m_button_list = (-foreground         => $config{colors}{background},
		     -activeforeground	 => $config{colors}{activebackground},
		     -background	 => $config{colors}{mbutton},
		     -activebackground	 => $config{colors}{activembutton});
my @m2_button_list = (-foreground         => $config{colors}{mbutton},
		      -activeforeground	 => $config{colors}{mbutton},
		      -background	 => $config{colors}{background},
		      -activebackground	 => $config{colors}{activebackground});
my @label_button  = (-relief=>'flat', -borderwidth=>0,);

my @browseentry_list = (-disabledforeground => $config{colors}{foreground},
			-state              => 'readonly');
@browseentry_list = () if $is_windows;

splash_message("Creating menus");

## ============================================================================
## ============================================================================
## menubar
$top -> configure(-menu=> my $menubar = $top->Menu(-relief=>'ridge'));



## --------------------------------------------------------------------
## The following 2 arrays will contain group and editing menus for
## use in the right-click menu and in various menubars.  They are set
## as global variables in &set_menus.
my (@edit_menuitems, @group_menuitems, @values_menuitems);
set_menus();

## --------------------------------------------------------------------
## Set up the right-click menu
my $group_menu = $top -> Menu(-tearoff=>0);
$group_menu ->
  cascade(-label=>"Plot this group ...", -tearoff=>0,
	  -menuitems=>[[ command => "in energy",  -command => \&plot_current_e],
		       [ command => "in k space", -command => \&plot_current_k],
		       [ command => "in R space", -command => \&plot_current_r],
		       [ command => "in q space", -command => \&plot_current_q, #,
		       ]]);

$group_menu ->
  cascade(-label=>"Plot marked groups ...", -tearoff=>0,
	  -menuitems=>[[ command => 'in energy',  -command => \&plot_marked_e],
		       [ command => 'in k-space', -command => \&plot_marked_k],
		       [ command => 'in R-space', -command => \&plot_marked_r],
		       [ command => 'in q-space', -command => \&plot_marked_q, #,
		       ],
		      ]);
$group_menu -> separator(-background=>$config{colors}{background});
my $right_group = $group_menu-> cascade(-label=>"Group actions",
					-tearoff=>0, @group_menuitems);
my $right_values = $group_menu-> cascade(-label=>"Parameter values",
					 -tearoff=>0, @values_menuitems);
$top -> update;

## --------------------------------------------------------------------
## Set up the various menubar menus
my @menu_args = (-foreground       => $config{colors}{foreground},
		 -background       => $config{colors}{background},
		 -activeforeground => $config{colors}{activebutton},); # -font =>


## File menu
##  &read_file recognizes raw data, records, and/or projects
my $file_menu =
  $menubar -> cascade(-label=>'~File', @menu_args,
		      -menuitems=>[[ command =>($Tk::VERSION < 804) ? 'Open file' : 'Open file(s)',
				    -accelerator=>'Ctrl-o',
				    -command =>[\&read_file, 0]],
				   (($Tk::VERSION < 804)
				    ? ([ command =>'Open many files', -accelerator=>'Alt-o',
					 -command =>[\&read_file, 1]],)
				    : ()),
				   [ cascade =>'Recent files', -tearoff=>0],
				   #[ command =>'Open URL',
				   # -command => \&fetch_url,
				   # -state   => 'disabled'],
				    ##-state   => ($lwp_exists) ? "normal" : 'disabled'],
				   #['command'=>'Open SPEC file', -state=>'disabled'],
				   "-",
				   [ command => 'Save entire project', -accelerator=>'Ctrl-s',
				    -command => [\&save_project, 'all quick']],
				   [ command => 'Save entire project as ...',
				    -command => [\&save_project, 'all']],
				   [ command => 'Save marked groups as a project ...',
				    -command => [\&save_project, 'marked']],
				   "-",
				   [ command => 'Save mu(E)',    -command => [\&save_chi, 'e']],
				   [ command => 'Save norm(E)',  -command => [\&save_chi, 'n']],
				   #[ command => 'Save deriv(E)', -command => [\&save_chi, 'd']],
				   [ cascade => 'Save chi(k)',
				    -tearoff => 0,
				    -menuitems => [[ command => "chi(k)",
						    -command => [\&save_chi, 'k']],
						   [ command => "k*chi(k)",
						    -command => [\&save_chi, 'k1']],
						   [ command => "k^2*chi(k)",
						    -command => [\&save_chi, 'k2']],
						   [ command => "k^3*chi(k)",
						    -command => [\&save_chi, 'k3']],
						   [ command => "chi(e)",
						    -command => [\&save_chi, 'ke']],
						  ]],
				   [ command => 'Save chi(R)',   -command => [\&save_chi, 'R']],
				   [ command => 'Save chi(q)',   -command => [\&save_chi, 'q']],
				   "-",
				   [ cascade   => 'Save marked groups to a file as',
				    -tearoff   => 0,
				    -menuitems => [[ command => 'mu(E)',
						    -command => [\&save_marked, 'e']],
						   [ command => 'norm(E)',
						    -command => [\&save_marked, 'n']],
						   [ command => 'deriv mu(E)',
						    -command => [\&save_marked, 'd']],
						   [ command => 'deriv norm(E)',
						    -command => [\&save_marked, 'nd']],
						   "-",
						   [ command => 'chi(k)',
						    -command => [\&save_marked, 'k']],
						   [ command => 'k*chi(k)',
						    -command => [\&save_marked, 'k1']],
						   [ command => 'k^2*chi(k)',
						    -command => [\&save_marked, 'k2']],
						   [ command => 'k^3*chi(k)',
						    -command => [\&save_marked, 'k3']],
						   "-",
						   [ command => '|chi(R)|',
						    -command => [\&save_marked, 'rm']],
						   [ command => 'Re[chi(R)]',
						    -command => [\&save_marked, 'rr']],
						   [ command => 'Im[chi(R)]',
						    -command => [\&save_marked, 'ri']],
						   "-",
						   [ command => '|chi(q)|',
						    -command => [\&save_marked, 'qm']],
						   [ command => 'Re[chi(q)]',
						    -command => [\&save_marked, 'qr']],
						   [ command => 'Im[chi(q)]',
						    -command => [\&save_marked, 'qi']],
						  ]],
				   [ cascade   => 'Save each marked group as',
				    -tearoff   => 0,
				    -menuitems => [[ command => 'mu(E)',
						    -command => [\&save_each, 'e']],
						   [ command => 'norm(E)',
						    -command => [\&save_each, 'n']],
						   ##[ command => 'deriv mu(E)',
						   ## -command => [\&save_each, 'd']],
						   ##[ command => 'deriv norm(E)',
						   ## -command => [\&save_each, 'nd']],
						   "-",
						   [ command => 'chi(k)',
						    -command => [\&save_each, 'k']],
						   [ command => 'k*chi(k)',
						    -command => [\&save_each, 'k1']],
						   [ command => 'k^2*chi(k)',
						    -command => [\&save_each, 'k2']],
						   [ command => 'k^3*chi(k)',
						    -command => [\&save_each, 'k3']],
						   [ command => 'chi(E)',
						    -command => [\&save_each, 'ke']],
						   "-",
						   [ command => 'chi(R)',
						    -command => [\&save_each, 'R']],
						   [ command => 'chi(q)',
						    -command => [\&save_each, 'q']],
						  ]],
				   "-",
				   [ command => "Clear project name", -accelerator=>'Ctrl-zero',
				    -command => \&clear_project_name],
				   "-",
				   [ command => "Close project", -accelerator=>'Ctrl-w',
				    -command => \&close_project],
				   [ command => 'Quit', -accelerator=>'Ctrl-q',
				    -command => \&quit_athena]
				  ]);

## Edit menu (need to disable some when Defaults are current)
$menubar -> cascade(-label=>'~Edit', @menu_args, @edit_menuitems);

## Group menu (need to disable some when Defaults are current)
my $group_menubutton = $menubar
  -> cascade(-label=>'~Group', @menu_args, @group_menuitems);

## Values menu (need to disable some when Defaults are current)
my $values_menubutton = $menubar
  -> cascade(-label=>'~Values', @menu_args, @values_menuitems);

$menubar -> separator;


## ## vertical separator
## $menubar -> Frame(-width=>2, -borderwidth=>2, -relief=>'sunken') ->
##   pack(-side=>'left', -fill=>'y', -pady=>2);

## Plot menu (need to disable some of these when Defaults are displayed in fat)
my $plot_menu;
my @plot_menuitems = ();

push @plot_menuitems,
  [ command => 'Zoom',   -accelerator => 'Ctrl-=', -command => \&zoom],
  [ command => 'Unzoom', -accelerator => 'Ctrl--', -command => [\&replot, 'replot']],
  [ command => 'Cursor', -accelerator => 'Ctrl-.', -command => \&cursor],
  '-',
  [ command => 'Plot merge+std.dev.', -state=>'disabled',
   -command => sub{my $group = $groups{$current}->{group};
		   my $space = $groups{$current}->{is_merge};
		   &plot_merge($group, $space);
		 }],
  [ command => 'Plot mu(E) + I0', -state=>'disabled',
   -command => [\&plot_i0, 1]],
  [ command => 'Plot I0', -state=>'disabled',
   -command => [\&plot_i0, 0]],
  [ command => 'Plot I0, marked', -state=>'normal',
   -command => \&plot_i0_marked],
  "-";

my %image_formats = (gif   => "GIF (landscape)",
		     vgif  => "GIF (portrait)",
		     png   => "PNG (landscape)",
		     vpng  => "PNG (portrait)",
		     tpng  => "PNG (transparent)",
		     ps	   => "B/W Postscript (landscape)",
		     cps   => "Color Postscipt (landscape)",
		     vps   => "B/W Postscript (portrait)",
		     vcps  => "Color Postscipt (portrait)",
		     latex => "LaTeX picture environment",
		     ppm   => "PPM (landscape)",
		     vppm  => "PPM (portrait)",
		     		    );
my @format_list;
foreach my $f ( split(" ", Ifeffit::get_string('plot_devices')) ) {
  next if (lc($f) =~ /(aqt|cgw|null|gw|x(window|serve))/);
  my $format = substr($f,1);
  $image_formats{$format} ||= $format;
  push @format_list, [command =>$image_formats{$format}, -command  =>[\&replot, $f]];
};
push @plot_menuitems,
  [cascade=>"Save image as ...", -tearoff=>0,
   -state=>(@format_list) ? 'normal' : 'disabled',
   @group_menuitems, -menuitems=>\@format_list];
##(@format_list) or $image_save -> configure(-state=>'disabled');
push @plot_menuitems,
  [ command     => 'Print last plot',
   -accelerator => 'Ctrl-p',
   -command     => [\&replot, 'print'],
   -state       => ($is_windows)?'disabled':'normal'];
# push @plot_menuitems, [ command => 'Detach plot buttons',
# 		       -command => \&detach_plot]
#   unless ($is_windows);

my $groupreplot = $config{general}{groupreplot};
push @plot_menuitems,
  "-",
  [ cascade => "Group replot", -tearoff=>0,
    -menuitems=>[
		 [ radiobutton  => 'none',
		   -selectcolor => $config{colors}{single},
		   -variable    => \$groupreplot,
		   -command     => sub{$config{general}{groupreplot}='none'},
		 ],
		 [ radiobutton  => 'E',
		   -selectcolor => $config{colors}{single},
		   -variable    => \$groupreplot,
		   -command     => sub{$config{general}{groupreplot}='e'},
		 ],
		 [ radiobutton  => 'k',
		   -selectcolor => $config{colors}{single},
		   -variable    => \$groupreplot,
		   -command     => sub{$config{general}{groupreplot}='k'},
		 ],
		 [ radiobutton  => 'R',
		   -selectcolor => $config{colors}{single},
		   -variable    => \$groupreplot,
		   -command     => sub{$config{general}{groupreplot}='r'},
		 ],
		 [ radiobutton  => 'q',
		   -selectcolor => $config{colors}{single},
		   -variable    => \$groupreplot,
		   -command     => sub{$config{general}{groupreplot}='q'},
		 ],
		]];



$plot_menu = $menubar -> cascade(-label=>'~Plot', @menu_args,
				 -menuitems=>\@plot_menuitems);
#($Tk::VERSION >= 804) and $plot_menu->menu->entryconfigure(14, -state=>'disabled');



## Mark menu
my $mark_menu = $menubar ->
  cascade(-label=>'Mark', @menu_args, -underline=>2,
	  -menuitems=>[[ command => 'Mark all groups',          -accelerator => 'Ctrl-a',
			-command => sub{mark('all')}],
		       [ command => 'Invert marks',             -accelerator => 'Ctrl-i',
			-command => sub{mark('toggle')}],
		       [ command => 'Clear all marks',          -accelerator => 'Ctrl-u',
			-command => sub{mark('none')}],
		       [ command => "Toggle this group's mark", -accelerator => 'Ctrl-t',
			-command => sub{mark('this')}],
		       [ command => "Mark regex",               -accelerator => 'Ctrl-r',
			-command => sub{mark('regex')}],
		       [ command => "Unmark regex",
		        -command => sub{mark('unregex')}],
		      ]);

## ## vertical separator
## $menubar -> Frame(-width=>2, -borderwidth=>2, -relief=>'ridge') ->
##   pack(-side=>'left', -fill=>'y', -pady=>2);

$menubar -> separator;

## Data munging menu
#my $flatten = $config{bkg}{flatten};
my $data_menu = $menubar ->
  cascade(-label=>'~Data', @menu_args,
	  -menuitems=>[[command => "Calibrate energies",       -command => \&calibrate],
		       [command => 'Align scans',              -command => sub{&align_two($config{align}{align_default})}],
		       [command => "Calibrate dispersive XAS", -command => \&pixel, -state   => ($config{pixel}{do_pixel_check}) ? 'normal' : 'disabled', ],
		       [command => 'Deglitch',	               -command => \&deglitch_palette],
		       [command => 'Truncate',	               -command => \&truncate_palette],
		       [command => 'Rebin mu(E)',	       -command => \&rebin],
		       [command => 'Smooth mu(E)',	       -command => \&smooth],
		       [command => 'Convolute mu(E)',          -command => \&convolve],
		       [command => 'Self Absorption',          -command => \&sa],
		       [command => 'MEE correction',           -command => \&mee, -state => ($config{mee}{enable}) ? 'normal' : 'disabled', ],
		       ##[command => 'Dead time',	             -state   => 'disabled'],
		       ##"-",
		       ##[command => 'How many spline knots?', -command=>sub{Echo(&nknots)}xb,
		       ## -state=>'disabled'],
		      ]);


## Alignment menu
# my $align_menu = $menubar ->
#   cascade(-label=>'~Align', @menu_args,
# 	  -menuitems=>[[ command => 'Align scans',
# 		        -command => sub{&align_two($config{align}{align_default})}],
# 		       [ command => "Calibrate dispersive XAS",
# 		        -state   => ($config{pixel}{do_pixel_check}) ? 'normal' : 'disabled',
# 		        -command => \&pixel],
# 		      ]);


## Merge menu
my $merge_weight='Weight by importance';
my $merge_menu = $menubar ->
  cascade(-label=>'~Merge', @menu_args,
	  -menuitems=>[
		       [command=> 'Merge marked data in mu(E)',   -command => [\&merge_groups, 'e']],
		       [command=> 'Merge marked data in norm(E)', -command => [\&merge_groups, 'n']],
		       [command=> 'Merge marked data in chi(k)',  -command => [\&merge_groups, 'k']],
		       ##"-",
		       ##[command=> 'Merge marked data in chi(R)',  -command => [\&merge_groups, 'r']],
		       ##[command=> 'Merge marked data in chi(q)',  -command => [\&merge_groups, 'q']],
		       "-",
		       [ radiobutton => 'Weight by importance',
			-selectcolor => $config{colors}{single},
			-variable    => \$merge_weight,
			-command     => sub{$config{merge}{merge_weight}='u'},
		       ],
		       [ radiobutton => 'Weight by chi_noise',
			-selectcolor => $config{colors}{single},
			-variable    => \$merge_weight,
			-command     => sub{$config{merge}{merge_weight}='n'},
		       ],
		      ]);

# ## Difference spectrum menu
# my $diff_menu = $menubar ->
#   cascade(-label=>'Diff', @menu_args, -underline=>1,
# 	  -menuitems=>[[ command => 'Difference spectra: norm(E)', -command => [\&difference, 'n']],
# 		       [ command => 'Difference spectra: chi(K)',  -command => [\&difference, 'k']],
# 		       "-",
# 		       [ command => 'Difference spectra: mu(E)',   -command => [\&difference, 'e']],
# 		       [ command => 'Difference spectra: chi(R)',  -command => [\&difference, 'r']],
# 		       [ command => 'Difference spectra: chi(q)',  -command => [\&difference, 'q']],
# 		      ]);

## Analysis menu
my $anal_menu = $menubar ->
  cascade(-label=>'~Analysis', @menu_args, #-underline=>4,
	  -menuitems=>[
		       [command => 'Linear combination fit', -command => \&lcf],
		       [command => 'Peak fit',               -command => \&peak_fit],
		       [command => 'PCA',	             -state   => 'disabled'],
		       [command => 'Log-Ratio',              -command => \&log_ratio],
		       [cascade => 'Difference spectra',     -tearoff => 0,
			-menuitems =>
			[[ command => 'Difference spectra: norm(E)', -command => [\&difference, 'n']],
			 [ command => 'Difference spectra: chi(K)',  -command => [\&difference, 'k']],
			 "-",
			 [ command => 'Difference spectra: mu(E)',   -command => [\&difference, 'e']],
			 [ command => 'Difference spectra: chi(R)',  -command => [\&difference, 'r']],
			 [ command => 'Difference spectra: chi(q)',  -command => [\&difference, 'q']],
			]
		       ],
		       (($demo_page) ?
			([command=>"Foobaricate", -command=>\&foobaricate]) :
			())
		      ]);

$menubar -> separator;

## Preferences menu
my $settings_menu =
  $menubar -> cascade(-label=>'~Settings', @menu_args, -tearoff=>0,
		      -menuitems=>[[ command => 'Swap panels',
				     -command => \&swap_panels,
				     -accelerator => 'Ctrl-/'],
				   ##['command'=>"Purge web download cache",
				   ## -command => \&purge_web_cache],
				   ['command'=>"Show key bindings",
				    -command => \&keys_show_all],
				   "-",
				   ['command'=>"Edit preferences", -command=>\&prefs],
				   ['command'=>"Plugin registry",  -command=>\&registry],
				   ['command'=>"Edit key bindings",
				    -command=>\&key_bindings],
				  ]);
## Help menu
my $help_menu =
  $menubar -> cascade(-label=>'~Help', @menu_args, -tearoff=>0, # -underline=>0,
		      -menuitems=>[['command'=> 'Document', -accelerator=>'Ctrl-m',
				    -command =>sub{pod_display("index.pod")}],
				   ['cascade'=>'Document sections',
				    -menuitems=>
				    [[ cascade => "Importing data",
				       -menuitems=>
				       [[ command => "The column selection dialog",
					 -command => sub{pod_display("import::columns.pod")}],
					[ command => "The project selection dialog",
					 -command => sub{pod_display("import::projsel.pod")}],
					[ command => "Importing multiple data sets",
					 -command => sub{pod_display("import::multiple.pod")}],
					[ command => "Reference channel",
					 -command => sub{pod_display("import::ref.pod")}],
					[ command => "Data preprocessing",
					 -command => sub{pod_display("import::preproc.pod")}],
					[ command => "Filetype plugin",
					 -command => sub{pod_display("import::plugin.pod")}],
				       ]],
				     [ cascade => "Background removal",
				       -menuitems=>
				       [[ command => "Normalization",
					 -command => sub{pod_display("bkg::norm.pod")}],
					[ command => "Understanding Fourier transforms",
					 -command => sub{pod_display("bkg::ft.pod")}],
					[ command => "The Rbkg parameter",
					 -command => sub{pod_display("bkg::rbkg.pod")}],
					[ command => "Spline clamps and k-weights",
					 -command => sub{pod_display("bkg::kweight.pod")}],
					[ command => "Spline range",
					 -command => sub{pod_display("bkg::range.pod")}],
				       ]],
				     [ cascade => "Plotting ",
				       -menuitems=>
				       [[ command => "Plot space tabs",
					 -command => sub{pod_display("plot::tabs.pod")}],
					[ command => "Stacking plots",
					 -command => sub{pod_display("plot::stack.pod")}],
					[ command => "Plot indicators",
					 -command => sub{pod_display("plot::indic.pod")}],
					[ command => "Point finder",
					 -command => sub{pod_display("plot::pf.pod")}],
					[ command => "Group-specific parameters",
					 -command => sub{pod_display("plot::params.pod")}],
					[ command => "Other plotting features",
					 -command => sub{pod_display("plot::etc.pod")}],
				       ]],
				     [ cascade => "User interface",
				       -menuitems=>
				       [[ command => "Using the group list",
					 -command => sub{pod_display("ui::glist.pod")}],
					[ command => "Marking groups",
					 -command => sub{pod_display("ui::mark.pod")}],
					[ command => "Pluck buttons",
					 -command => sub{pod_display("ui::pluck.pod")}],
					[ command => "Plot styles",
					 -command => sub{pod_display("ui::styles.pod")}],
					[ command => "Using k-weights",
					 -command => sub{pod_display("ui::kweight.pod")}],
					[ command => "Frozen groups",
					 -command => sub{pod_display("ui::frozen.pod")}],
					[ command => "Palettes",
					 -command => sub{pod_display("ui::palettes.pod")}],
					[ command => "Setting preferences",
					 -command => sub{pod_display("ui::prefs.pod")}],
				       ]],
				     [ cascade => "Setting parameter values",
				       -menuitems=>
				       [[ command => "Constraining parameters",
					 -command => sub{pod_display("params::constrain.pod")}],
					[ command => "Edge energy",
					 -command => sub{pod_display("params::e0.pod")}],
					[ command => "Default values",
					 -command => sub{pod_display("params::defaults.pod")}],
				       ]],
				     [ cascade => "Output files",
				       -menuitems=>
				       [[ command => "Column output files",
					 -command => sub{pod_display("output::column.pod")}],
					[ command => "Project files",
					 -command => sub{pod_display("output::project.pod")}],
					[ command => "Report files",
					 -command => sub{pod_display("output::report.pod")}],
				       ]],
				     [ cascade => "Data processing           ",
				       -menuitems=>
				       [[ command => "Energy calibration",
					 -command => sub{pod_display("process::cal.pod")}],
					[ command => "Aligning data",
					 -command => sub{pod_display("process::align.pod")}],
					[ command => "Deglitching data",
					 -command => sub{pod_display("process::deg.pod")}],
					[ command => "Truncating data",
					 -command => sub{pod_display("process::trun.pod")}],
					[ command => "Smoothing data",
					 -command => sub{pod_display("process::smooth.pod")}],
					[ command => "Convolving data",
					 -command => sub{pod_display("process::conv.pod")}],
					[ command => "Self-asborption",
					 -command => sub{pod_display("process::sa.pod")}],
					[ command => "Dispersive data",
					 -command => sub{pod_display("process::pixel.pod")}],
					[ command => "Merging data",
					 -command => sub{pod_display("process::merge.pod")}],
				       ]],
				     [ cascade => "Analysis                 ",
				       -menuitems=>
				       [[ command => "Linear combination",
					 -command => sub{pod_display("analysis::lcf.pod")}],
					[ command => "Peak fitting",
					 -command => sub{pod_display("analysis::peak.pod")}],
					[ command => "PCA",
				         -command => sub{pod_display("analysis::pca.pod")}],
					[ command => "Log-ratio",
				         -command => sub{pod_display("analysis::lr.pod")}],
					[ command => "Difference spectra",
					 -command => sub{pod_display("analysis::diff.pod")}],
					##[ command => "Foobaricate",
					## -command => sub{pod_display("process::foobar.pod"))}],
				       ]],
				    ]
				   ],
				   "-",
				   ['command'=>'Import a demo project',
				    -command =>\&read_demo],
				   ['command'=>'About demo projects',
				    -command =>\&about_demos],
				   ['command'=>"Explain Fourier transforms",
				    -command =>\&teach_ft],
				   "-",
				   ['command'=> 'Show a hint', -accelerator=>'Ctrl-h',
				    -command => \&show_hint],
				   [ command => "About current group", -accelerator=>'Ctrl-b',
				    -command => \&about_group],
				   [ command => "About marked groups", -accelerator=>'Ctrl-B',
				    -command => sub{about_marked_groups(\%marked)}],
				   ['command'=> 'Dump groups',
				    -command => \&Dumpit],
				   ['command'=> 'About Ifeffit',
				    -command => sub{Echo("Using Ifeffit ".
							 Ifeffit::get_string("\$&build"))}],
				   ['command'=> 'About Athena',
				    -command => sub{Echo($About)}],
				   ['command'=>"Check Ifeffit's memory usage",
				    -command =>
				    sub{$groups{"Default Parameters"}
					  -> memory_check($top, \&Echo, \%groups, $max_heap, 1, 0)}],
				  ]);


## diable the last item if this is a version of ifeffit that does not
## report max_heap
($max_heap == -1) and $help_menu -> menu -> entryconfigure(10, -state=>'disabled');

# $top -> bind('<Alt-h>' => sub{$help_menu->Post});

splash_message("Creating echo area");


## help & echo area
my $ebar = $top -> Frame(-relief=>'flat', -borderwidth=>3)
  -> pack(-side=>"bottom", -fill=>'x');
my $echo = $ebar -> Label(qw/-relief flat -justify left -anchor w
			  -font/, $config{fonts}{small},
			  -foreground=>$config{colors}{button},
			  -text=> "")
  -> pack(-side=>'left', -expand=>1, -fill=>'x', -pady=>2);
my $balloon = $top -> Balloon(-state=>'status', -statusbar=>$echo, -initwait=>0);
$echo -> bind('<KeyPress>' => sub{$multikey = $Tk::event->K; });

##  hints for the echo area about the various analysis functions
## $balloon -> attach($data_menu->menu,
## 		   -msg=>['',
## 			  'Calibrate the energy scale of mu(E) spectra',
## 			  'Remove spurious data points interactively or algorithmically',
## 			  'Remove all data points beyond a specified energy',
## 			  'Smooth a data set by interpolation or Fourier filtering',
## 			  'Convolute a mu(E) spectrum by a Gaussian or a Lorentzian',
## 			  'Correct data for self-absorption attenuations in fluorescence data',
## 			  'Correct data for detector dead time'
## 			 ]);
## $balloon -> attach($anal_menu->menu -> cget(-menu),
## 		   -msg=>['',
## 			  'Perform a log-ratio/phase-difference analysis using two data groups',
## 			  #'Do Principle Components Analysis on the set of marked groups',
## 			  'Principle Component Analysis is not yet a part of Athena.',
## 			  'Fit peak lineshapes and an arc-tangent to XANES data',
## 			  'Fit data as a linear combination of reference spectra',
## 			 ]);
## sub menubutton_attach {
##   my ($b, $mb, $msg) = @_;
##   $b -> attach($mb, -msg=>$msg);
##   $b -> attach($mb->cget(-menu), -msg=>$msg);
## };
## menubutton_attach($balloon, $align_menu,
## 		  "Align groups in energy by interactively changing energy shifts.");
## menubutton_attach($balloon, $merge_menu,
## 		  "Merge ALL MARKED groups in the chosen space.");
## menubutton_attach($balloon, $diff_menu,
## 		  "Compute difference spectra by subtracting one group from another.");
## menubutton_attach($balloon, $mark_menu,
## 		  "Mark groups by selecting the checkbuttons in the list of data groups.");


splash_message("Creating Groups list");

## left panel (fat) (group properties)
#my $fat = $top -> Scrolled('Pane', -scrollbars=>'oe', -relief=>'sunken',
#			   -borderwidth=>3, -width=>'13c')
my $container = $top -> Frame(-relief=>'flat', -borderwidth=>0)
  -> pack(-fill=>'both', -side=>$config{general}{fatside}, -expand=>1);
my $fat = $container -> Frame(-relief=>'sunken', -borderwidth=>3)
  -> pack(-fill=>'both', -expand=>1);
my %props;


my @bold   = (-foreground => $config{colors}{foreground},
	      -background => $config{colors}{activebackground},
	      -font       => $config{fonts}{small},
	      -cursor     => $mouse_over_cursor,);
my @normal = (-foreground => $config{colors}{foreground},
	      -background => $config{colors}{background},
	      -font       => $config{fonts}{small},
	      -cursor     => "top_left_arrow");

## right panel (skinny) (group list and plotting palette)
my @skinny_list = ();
my $skinny = $top -> Frame(-relief=>'sunken', -borderwidth=>4)
  -> pack(-expand=>1, -fill=>'both', -side=>$config{general}{listside});
my $top_frame = $skinny -> Frame(-relief=>'ridge', -borderwidth=>2)
  -> pack(-side=>'top', -fill => 'x', -anchor=>'n');
my $lab = $top_frame -> Label(-text    => q{},
			      @normal,
			      #-cursor  => $mouse_over_cursor,
			      -justify => 'center',
			      -relief  => 'flat')
  -> pack(-side=>'right', -fill=>'x', -expand=>1);
$lab -> bind("<ButtonPress-1>",  sub{save_project('all quick') unless $project_saved});
$lab -> bind("<ButtonPress-2>",  sub{save_project('all quick') unless $project_saved});
$lab -> bind("<ButtonPress-3>",  sub{save_project('all quick') unless $project_saved});
$lab -> bind('<Any-Enter>'    => sub{shift -> configure(($project_saved) ? @normal : @bold)});
$lab -> bind('<Any-Leave>'    => sub{shift -> configure( @normal);});
$top_frame -> Button(-text=>"A", -font=>$config{fonts}{smbold}, @m2_button_list,
		     -padx=>2,
		     -pady=>0,
		     -borderwidth=>1,
		     -command=>sub{mark('all')})
  -> pack(-side=>'left');
$top_frame -> Button(-text=>"U", -font=>$config{fonts}{smbold}, @m2_button_list,
		     -padx=>2,
		     -pady=>0,
		     -borderwidth=>1,
		     -command=>sub{mark('none')})
  -> pack(-side=>'left');
$top_frame -> Button(-text=>"I", -font=>$config{fonts}{smbold}, @m2_button_list,
		     -padx=>4,
		     -pady=>0,
		     -borderwidth=>1,
		     -command=>sub{mark('toggle')})
  -> pack(-side=>'left');


splash_message("Creating plotting controls");

$list = $skinny -> Scrolled(qw/Canvas -relief flat -borderwidth 0
			    -scrollbars e -width 5c -height 0.1c/,
			    -scrollregion=>['0', '0', '200', '200'])
## $list = $skinny -> Scrolled(qw/Pane -relief flat -borderwidth 0
## 			    -scrollbars e -width 5c -height 0.1c/,)
   -> pack(-side=>'top', -expand=>1, -fill=>'both', -anchor=>'w');
$list->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
#BindMouseWheel($list);
## plot button bar
$b_frame = $skinny -> Frame(-relief=>'flat', -borderwidth=>0, -class=>'horae')
  -> pack(-side=>'top', -anchor=>'n', -fill=>'x');
$plotsel = $skinny -> NoteBook(-background	   => $config{colors}{background},
			       -backpagecolor	   => $config{colors}{background},
			       -inactivebackground => $config{colors}{inactivebackground},
			       -font		   => $config{fonts}{small},
			      );

$plot_features{kw} = $plot_features{k_w};
my $red = $config{colors}{single};
my $kw_frame = $skinny -> Frame(-relief=>'ridge', -borderwidth=>2)
  -> pack(-side=>'top', -anchor=>'n', -fill => 'x');
$kw_frame -> Radiobutton(-text	      => 0,
			 -variable    => \$plot_features{kw},
			 -value	      => 0,
			 -padx	      => 1,
			 -selectcolor => $red,
			 -command     => \&kw_button,
			)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');
$kw_frame -> Radiobutton(-text	      => 1,
			 -variable    => \$plot_features{kw},
			 -value	      => 1,
			 -padx	      => 1,
			 -selectcolor => $red,
			 -command     => \&kw_button,
			)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');
$kw_frame -> Radiobutton(-text	      => 2,
			 -variable    => \$plot_features{kw},
			 -value	      => 2,
			 -padx	      => 1,
			 -selectcolor => $red,
			 -command     => \&kw_button,
			)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');
$kw_frame -> Radiobutton(-text	      => 3,
			 -variable    => \$plot_features{kw},
			 -value	      => 3,
			 -padx	      => 1,
			 -selectcolor => $red,
			 -command     => \&kw_button,
			)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');
$kw_frame -> Radiobutton(-text	      => 'kw',
			 -variable    => \$plot_features{kw},
			 -value	      => 'kw',
			 -padx	      => 1,
			 -selectcolor => $red,
			 -command     => \&kw_button,
			)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');

$plot_features{options_showing} = 1;
my $po_frame = $skinny -> Frame()
  -> pack(-side=>'top', -anchor=>'n', -fill => 'x');
my $po_left  = $po_frame -> Button(-text    => 'v',
				   -font    => $config{fonts}{smbold},
				   -cursor  => $mouse_over_cursor,
				   -padx    => 1,
				   -pady    => 0,
				   -command => \&hide_show_plot_options)
  -> pack(-side=>'left', -anchor=>'n');
my $po       = $po_frame -> Label(-text	   => 'Plotting options',
				  @normal,
				  -cursor  => $mouse_over_cursor,
				  -justify => 'center',
				  -relief  => 'raised')
  -> pack(-side=>'left', -fill => 'x', -expand=>1);
my $po_right = $po_frame -> Button(-text    => 'v',
				   -font    => $config{fonts}{smbold},
				   -cursor  => $mouse_over_cursor,
				   -padx    => 1,
				   -pady    => 0,
				   -command => \&hide_show_plot_options);

$po -> bind('<Any-Enter>'=>sub{my $po = shift;
			       $po -> configure( @bold  );
			     });
$po -> bind('<Any-Leave>'=>sub{my $po = shift;
			       $po -> configure( @normal);
			     });
$po -> bind('<1>' => sub{Echo("Right click to post the Plot styles menu.  Click the arrow button to hide/show the plotting options.")});
$po -> bind('<2>' => \&plst_post_menu);
$po -> bind('<3>' => \&plst_post_menu);
$po_left  -> bind('<2>' => \&hide_show_plot_options);
$po_left  -> bind('<3>' => \&hide_show_plot_options);
$po_right -> bind('<2>' => \&hide_show_plot_options);
$po_right -> bind('<3>' => \&hide_show_plot_options);

# $b_frame -> Label(-text=>"Plot current group in", -relief=>'raised',
# 		  -font=>$config{fonts}{smbold},
# 		  -foreground=>$config{colors}{activehighlightcolor})
#   -> pack(-side=>'top', -anchor=>'n', -fill => 'x');
my $fr = $b_frame -> Frame(-relief=>'ridge', -borderwidth=>2)
  -> pack(-side=>'top', -anchor=>'n', -fill=>'both', -expand=>1);
my %b_red;
$b_red{E} = $fr -> Button(-text=>"E", -font=>$config{fonts}{smbold}, @r_button_list,
			  -pady=>1,
			  (($is_windows) ? (-width=>3) : ()),
			  -command=> \&plot_current_e)
  -> pack(-anchor=>'w', -side=>'left', -expand=>1, -fill=>'both');
$b_red{k} = $fr -> Button(-text=>"k", -font=>$config{fonts}{smbold}, @r_button_list,
			  -pady=>1,
			  (($is_windows) ? (-width=>3) : ()),
			  -command=> \&plot_current_k)
  -> pack(-anchor=>'w', -side=>'left', -expand=>1, -fill=>'both');
$b_red{R} = $fr -> Button(-text=>"R", -font=>$config{fonts}{smbold}, @r_button_list,
			  -pady=>1,
			  (($is_windows) ? (-width=>3) : ()),
			  -command=> \&plot_current_r)
  -> pack(-anchor=>'w', -side=>'left', -expand=>1, -fill=>'both');
$b_red{q} = $fr -> Button(-text=>"q", -font=>$config{fonts}{smbold}, @r_button_list,
			  -pady=>1,
			  (($is_windows) ? (-width=>3) : ()),
			  -command=> \&plot_current_q)
  -> pack(-anchor=>'w', -side=>'left', -expand=>1, -fill=>'both');
$b_red{kq} = $fr -> Button(-text=>"kq", -font=>$config{fonts}{smbold}, @r_button_list,
			  -pady=>1,
			   (($is_windows) ? (-width=>3) : ()),
			   -command=>
			   sub{ my $str = "kq";
				Echo('No data!'), return unless ($current);
				return unless &verify_ranges($current, 'kq');
				$top -> Busy(-recurse=>1,);
				(($plot_features{k_win} eq "w") or ($plot_features{q_win} eq "w"))
				  and ($str = "kqw");
				$groups{$current}->plotkq($str,$dmode,\%plot_features, \@indicator);
				$pointfinder{space} -> configure(-text=>"The last plot was in k");
				&refresh_properties;
				($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot =~ /[kq]/);
				$last_plot='kq';
				$last_plot_params = [$current, 'group', 'kq', $str];
				$plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
				section_indicators();
				foreach (qw(x xpluck xfind y ypluck yfind clear)) {
				  $pointfinder{$_} -> configure(-state=>'normal');
				};
				$top->Unbusy; })
  -> pack(-anchor=>'w', -side=>'left', -expand=>1, -fill=>'both');



# $b_frame -> Label(-text=>"Plot marked group in", -relief=>'raised',
# 		  -font=>$config{fonts}{smbold},
# 		  -foreground=>$config{colors}{activehighlightcolor})
#   -> pack(-side=>'top', -anchor=>'n', -fill => 'x');
$fr = $b_frame -> Frame(-relief=>'ridge', -borderwidth=>2)
  -> pack(-side=>'top', -anchor=>'n', -fill=>'both', -expand=>1);
$fr -> Button(-text=>"q", -font=>$config{fonts}{smbold}, @m_button_list,
	      -pady=>1,
	      (($is_windows) ? (-width=>3) : ()),
	      -command => \&plot_marked_q#foo#
	     )
  -> pack(-anchor=>'e', -side=>'right', -expand=>1, -fill=>'both');
$fr -> Button(-text=>"R", -font=>$config{fonts}{smbold}, @m_button_list,
	      -pady=>1,
	      (($is_windows) ? (-width=>3) : ()),
	       -command => \&plot_marked_r)
  -> pack(-anchor=>'e', -side=>'right', -expand=>1, -fill=>'both');
$fr -> Button(-text=>"k", -font=>$config{fonts}{smbold}, @m_button_list,
	      -pady=>1,
	      (($is_windows) ? (-width=>3) : ()),
	       -command => \&plot_marked_k)
  -> pack(-anchor=>'e', -side=>'right', -expand=>1, -fill=>'both');
$fr -> Button(-text=>"E", -font=>$config{fonts}{smbold}, @m_button_list,
	      -pady=>1,
	      (($is_windows) ? (-width=>3) : ()),
	       -command => \&plot_marked_e)
  -> pack(-anchor=>'e', -side=>'right', -expand=>1, -fill=>'both');



my @pc_args = (-anchor=>'center');
foreach (qw/e k r q/) {
  my $lab = "E";
  ($_ eq 'k') and ($lab = "k");
  ($_ eq 'r') and ($lab = "R");
  ($_ eq 'q') and ($lab = "q");
  $plotcard{$_} = $plotsel -> add(lc($_), -label=>$lab, @pc_args);
};
$plotcard{Stack} = $plotsel -> add('Stack', -label=>'Stack', @pc_args);
$plotcard{Ind}   = $plotsel -> add('Ind',   -label=>'Ind',   @pc_args);
$plotcard{PF}    = $plotsel -> add('PF',    -label=>'PF',    @pc_args);
$plotsel->pack(-fill => 'x', -side => 'bottom', -anchor=>'s');


## pack the groups list last so it expands to fill all the rest of the space
$list -> pack(qw/-expand 1 -fill both/);






splash_message("Creating palettes");

## ----------------------------------------------------------------------
## Setup the toplevel window for various textual interactions,
## including the ifeffit buffer and the raw text edit
my $update = $top -> Toplevel(-class=>'horae');
$update -> withdraw;
$update -> title("Athena palettes");
$update -> bind('<Control-q>' => sub{$update->withdraw});
$update -> protocol(WM_DELETE_WINDOW => sub{$update->withdraw});
#$update -> iconbitmap('@'.$iconbitmap);
$update -> iconimage($iconimage);
my $notebook = $update -> NoteBook(-backpagecolor=>$config{colors}{background},
				   -inactivebackground=>$config{colors}{inactivebackground},);
use vars qw(%notecard %notes %labels);
foreach my $n (qw/ifeffit titles data echo macro journal/) {
  $notecard{$n} = $notebook -> add(lc($n), -label=>ucfirst($n), -anchor=>'center', -underline=>0);
  my $topbar   = $notecard{$n} -> Frame(qw/-relief flat -borderwidth 2/)
    -> pack(qw/-fill x -side top/);
  $topbar  -> Button(-text=>'Dismiss', -command=>sub{$update->withdraw}, @button_list)
    -> pack(-side=>'right');
  ($n eq 'data') and
    $topbar  -> Button(-text=>'Edit current group', -command=>\&setup_data, @button_list)
    -> pack(-side=>'right');
  $labels{$n} = $topbar -> Label(-foreground=>$config{colors}{activehighlightcolor},
				 -font=>$config{fonts}{large})
    -> pack(-side=>'left');
  my ($h, $Text);
 SWITCH: {
    ($h, $Text) = (11, 'ROText'),   last SWITCH if ($n eq 'macro');
    ($h, $Text) = (13, 'TextUndo'), last SWITCH if ($n eq 'data');
    ($h, $Text) = (13, 'ROText'),   last SWITCH if ($n eq 'ifeffit');
    ($h, $Text) = (15, 'ROText'),   last SWITCH if ($n eq 'echo');
    ($h, $Text) = (15, 'TextUndo'), last SWITCH if ($n eq 'journal');
    ($h, $Text) = (15, 'TextUndo'), last SWITCH if ($n eq 'titles');
    ($h, $Text) = (13, 'ROText');
  };
  $notes{$n}    = $notecard{$n} -> Scrolled($Text, qw/-relief sunken -borderwidth 2
					    -wrap none -scrollbars se -width 70 -height/, $h,
					    -font=>$config{fonts}{fixed})
    -> pack(qw(-expand 1 -fill both -side top));
  $notebook -> pageconfigure($n, -raisecmd=>sub{$notes{$n}->focus});
  BindMouseWheel($notes{$n});
  disable_mouse3($notes{$n}->Subwidget(lc($Text)));
  $notes{$n} -> Subwidget("yscrollbar") -> configure(-background=>$config{colors}{background});
  $notes{$n} -> Subwidget("xscrollbar") -> configure(-background=>$config{colors}{background});
  $notes{$n} -> tagConfigure("text", -font=>$config{fonts}{fixedsm});

};
$notebook->pack(-expand => 1, -fill => 'both', -side => 'bottom');
$labels{ifeffit} -> configure(-text=>"Ifeffit interaction buffer");
$notes{ifeffit}  -> tagConfigure ('command',  -foreground=>$config{colors}{foregroun},
				  -lmargin1=>4, -lmargin2=>4);
$notes{ifeffit}  -> tagConfigure ('response', -foreground=>$config{colors}{highlightcolor},
				  -lmargin1=>20, -lmargin2=>20);
$notes{ifeffit}  -> tagConfigure ('comment',  -foreground=>$config{colors}{button},
				  -lmargin1=>4, -lmargin2=>4);
$labels{data}    -> configure(-text=>"Edit raw data");
$labels{echo}    -> configure(-text=>"Record of all text written to the echo area");
$labels{titles}  -> configure(-text=>"Titles for the current group");
$labels{macro}   -> configure(-text=>"Record a macro");
$labels{journal} -> configure(-text=>"Keep a journal of your analysis project");
$notes{journal}  -> configure(-wrap=>"word");
&setup_macro;


## set up the button bar in the data notecard
my $databbar = $notecard{data} -> Frame(qw/-relief flat -borderwidth 2/)
  -> pack(qw/-fill x -side bottom/);
$databbar -> Label(-textvariable=>\$current_file,
		   -foreground=>$config{colors}{activehighlightcolor},
		   -relief=>'groove')
  -> pack(qw/-expand yes -fill x -side left/);
$databbar -> Button(-text=>'Reload', @button_list, -command=>[\&save_and_reload, 0])
  -> pack(qw/-expand yes -fill x -side left/);
$databbar -> Button(-text=>'Save', @button_list, -command=>[\&save_and_reload, 1])
  -> pack(qw/-expand yes -fill x -side left/);
$databbar -> Button(-text=>'Clear', @button_list,
		    -command=>sub{$notes{data}->delete(qw/1.0 end/); $current_file="";})
  -> pack(qw/-expand yes -fill x -side left/);

## set up the button bar in the titles notecard
## $databbar = $notecard{titles} -> Frame(qw/-relief flat -borderwidth 2/)
##   -> pack(qw/-expand yes -fill x -side bottom/);
## $databbar -> Button(-text=>'Insert', -state=>'disabled')
##   -> pack(qw/-expand yes -fill x -side left/);


## set up the command line in the ifeffit interaction buffer
my $cmdline = $notecard{ifeffit} -> Frame(qw/-relief flat -borderwidth 2/)
  -> pack(qw/-fill x -side bottom/);
$cmdline -> Label(-text=>'Ifeffit> ', -font=>$config{fonts}{fixed},
		  -foreground=>$config{colors}{activehighlightcolor})
  -> pack(-side=>'left');
my $cmdbox = $cmdline -> Entry(qw/-width 60 -relief sunken -borderwidth 2/,
			       -font=>$config{fonts}{fixed})
  -> pack(-side=>'left', -fill=>'x', -expand=>'yes');
my @cmd_buffer = ("");
my $cmd_pointer = $#cmd_buffer;
$cmdbox->bind("<KeyPress-Return>", # dispose and push onto history
	      sub{ $setup->dispose($cmdbox->get()."\n", $dmode);
		   $cmd_buffer[$#cmd_buffer] =  $cmdbox->get();
		   push @cmd_buffer, "";
		   $cmd_pointer = $#cmd_buffer;
		   $cmdbox->delete(0,'end'); });
$cmdbox->bind("<KeyPress-Up>",	# previous command in history
	      sub{ --$cmd_pointer; ($cmd_pointer<0) and ($cmd_pointer=0);
		   $cmdbox->delete(0,'end');
		   $cmdbox->insert(0, $cmd_buffer[$cmd_pointer]); });
$cmdbox->bind("<KeyPress-Down>", # next command in history
	      sub{ ++$cmd_pointer; ($cmd_pointer>$#cmd_buffer) and ($cmd_pointer= $#cmd_buffer);
		   $cmdbox->delete(0,'end');
		   $cmdbox->insert(0, $cmd_buffer[$cmd_pointer]); });
$cmdbox->bind("<KeyPress-Tab>", # command completion
	      sub{ my $str = $cmdbox -> get;
		   my $i   = $cmdbox -> index('insert');
		   $str = substr($str, 0, $i);
		   $str = reverse $str;
		   $i = index($str, " ");
		   ($i != -1) and ($str = substr($str, 0, $i));
		   $str = reverse $str;
		   my $rep = $abbrevs{$str} || "";
		   ($rep) and ($rep = substr($rep, length($str)));
		   $cmdbox->insert('insert', $rep);
		   $cmdbox->break; # halt further searching of
                                   # bindtags list to avoid loosing
                                   # focus on this widget see Mastering
                                   # Perl/Tk, ch. 15, p. 374
		 });
## reserved word/group name completion
## $cmdbox->bind("<KeyPress-Tab>",
$top -> update;


$top -> bind('<Control-Key-1>' => sub{raise_palette('ifeffit'); $cmdbox->focus;});
$top -> bind('<Control-Key-2>' => sub{raise_palette('titles'); });
$top -> bind('<Control-Key-3>' => sub{raise_palette('data'); &setup_data});
$top -> bind('<Control-Key-4>' => sub{raise_palette('echo'); });
$top -> bind('<Control-Key-5>' => sub{raise_palette('macro'); });
$top -> bind('<Control-Key-6>' => sub{raise_palette('journal'); });



## --------------------------------------------------------------------
## fill in main window

splash_message("Populating main window");

my %widget = ();
my $screen = ", fg=$config{plot}{fg}, bg=$config{plot}{bg}, ";
$screen .= ($config{plot}{showgrid}) ? "grid, gridcolor=\"$config{plot}{grid}\"" : "nogrid";
my @fclist;
map {push @fclist, "color".$_, $config{plot}{'c'.$_}} (0 ..9);

## set default plotting colors
$setup -> SetDefault(screen=>$screen, @fclist,
		     'showmarkers',        $config{plot}{showmarkers},
		     'marker',             $config{plot}{marker},
		     'markersize',         $config{plot}{markersize},
		     'markercolor',        $config{plot}{markercolor},
		     #'indicator',          $config{plot}{indicator},
		     'indicatorcolor',     $config{plot}{indicatorcolor},
		     'indicatorline',      $config{plot}{indicatorline},
		     'bordercolor',        $config{plot}{bordercolor},
		     'borderline',         $config{plot}{borderline},
		     'interp',             $config{general}{interp},
		     'linetypes',          $config{plot}{linetypes},
		     'flatten',            $config{bkg}{flatten});

## set default analysis parameter values
&clear_session_defaults;


$top->update;
draw_properties($fat); #$props);
&set_plotcards;
project_state(1);
foreach my $part (qw(project current bkg bkg_secondary fft bft plot)) {
  my $fill = $config{colors}{disabledforeground};
  $header{$part} -> configure(-foreground=>$fill);
};
foreach ($setup -> Keys) {
  next if ((/^deg/) or ($_ eq "file") or ($_ eq "line"));
  next unless (Exists($widget{$_}));
  $widget{$_} -> configure(-state=>'disabled');
};
$widget{"bkg_$_"} -> configure(-state=>'disabled') foreach (qw(alg fixstep flatten nnorm1 nnorm2 nnorm3));
map {($_ =~ /^(deg|lr)/) or $grab{$_}   -> configure(-state=>'disabled')} (keys %grab);

##undef $setup;
($use_default) and fill_skinny($list, "Default Parameters", 0);


## set up error handlers
#$SIG{__DIE__}  = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'die',  $trapfile, \&Error)};
#$SIG{__WARN__} = sub{$groups{"Default Parameters"}->trap('Athena', $VERSION, 'warn', $trapfile, \&Error)};



## -------------------------------------------------------------------


&clean_old_trap_files;



## -------------------------------------------------------------------
## file type plugins

splash_message("Importing filetype plugins");

## names of standard file type plugins
use vars qw(@plugins);
my $plugindir = ($is_windows) ? File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'pluginiff'),
						    qw(Plugins Filetype Athena))
  : File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'plugininc'),
			qw(Plugins Filetype Athena));
mkdir $plugindir if (not -e $plugindir);
opendir PLUGINS, $plugindir;
@plugins = sort (map {substr($_, 0, -3)} (grep {/\.pm$/} readdir PLUGINS) );
closedir PLUGINS;
#@plugins = (qw(Encoder Lambda X10C BESSRC CMC SSRL X15B));
#pop @plugins if $is_windows;

unless (-e $groups{"Default Parameters"} -> find('athena', 'plugins')) {
  open P, ">".$groups{"Default Parameters"} -> find('athena', 'plugins');
  print P "[___foo]\n_enabled=0\n";
  close P;
};
my %plugin_params;
tie %plugin_params, 'Config::IniFiles', (-file=>$groups{"Default Parameters"} -> find('athena', 'plugins'));

## standard plugins
foreach my $p (@plugins) {
  Echonow("Loading system filetype plugin $p");
  if ($is_windows) {
    unshift @INC, $groups{"Default Parameters"} -> find('athena', 'plugininc');
    eval "require Ifeffit::Plugins::Filetype::Athena::$p;";
  } else {
    eval "require Ifeffit::Plugins::Filetype::Athena::$p;";
  };
  warn $@ if $@;
  ##eval "import Ifeffit::Plugins::Filetype::Athena::$p;";
  $plugin_params{$p}{_enabled} = 0 unless (exists $plugin_params{$p}{_enabled});
};

## user plugins
my $horae_dir = $groups{"Default Parameters"} -> find('athena', 'userplugininc');
unshift @INC, $horae_dir;
my $filetype_dir = $groups{"Default Parameters"} -> find('athena', 'userfiletypedir');
if (-e $filetype_dir) {
  opendir A, $filetype_dir;
  foreach (reverse (sort (grep {/pm$/} readdir A))) {
    my $this = File::Spec->catfile($filetype_dir, $_);
    my $ns = substr($_, 0 , -3);
    Echonow("Loading user filetype plugin $ns");
    eval "require(\'$this\');";
    unshift @plugins, $ns;
    $plugin_params{$ns}{_enabled} = 1 unless (exists $plugin_params{$ns}{_enabled});
  };
  closedir A;
};
delete $plugin_params{___foo};
tied( %plugin_params )->WriteConfig($groups{"Default Parameters"} -> find('athena', 'plugins'));

## -------------------------------------------------------------------

splash_message("Initializing Ifeffit");

my $macros_string = write_macros();
$groups{"Default Parameters"} -> dispose($macros_string, $dmode);
## set the charsize and charfont
##$groups{"Default Parameters"} -> dispose("plot(charsize=$config{plot}{charsize}, charfont=$config{plot}{charfont})", $dmode);
$groups{"Default Parameters"} -> dispose("startup", $dmode);

my $iffversion = Ifeffit::get_string("\$&build");
$iffversion =~ s{\A\s+}{};
Echonow("Using Ifeffit $iffversion");
$top -> after(2000, [\&Echonow, "Athena may be freely redistributed under the terms of its license."]);
$top -> after(3500, [\&Echonow, "Athena comes with absolutely NO WARRANTY."]);
$top -> after(5500, \&show_hint);

&set_recent_menu();		# establish MRU list
## need to save the geometry of the main window for use by things like
## thepeak fitting interface
my @fatgeom = ('-height', $fat->height, '-width', $fat->width);
#print join(" ", @fatgeom), $/;

splash_message("Ready to start...");
## remove splashscreen and display program
$top -> update;
$splash -> Destroy;
&set_key_params;

my @geom = split(/[+x]/, $top->geometry);
my $extrabit = ($is_windows) ? 0 : 40;
unless ($is_windows) {
  $top -> minsize(    $geom[0], $geom[1]+$extrabit);
  $top -> maxsize(1.3*$geom[0], $geom[1]+$extrabit);
};
## the +30 is kind of ad hoc.... why doesn't the menubar's size
## get reported correctly?
if (exists $mru{geometry}{'x'}) {
  $mru{geometry}{'x'} = 0 if ($mru{geometry}{'x'} < 0);
  $mru{geometry}{'x'} = 0 if ($mru{geometry}{'x'} > $top->screenwidth());
  $mru{geometry}{'y'} = 0 if ($mru{geometry}{'y'} < 0);
  $mru{geometry}{'y'} = 0 if ($mru{geometry}{'y'} > $top->screenheight());
  my $location = "+" . $mru{geometry}{'x'} . "+" . $mru{geometry}{'y'};
  ($location = $mru{geometry}{height} . "x" . $mru{geometry}{width} . $location) unless ($is_windows or ($mru{geometry}{height} < 0) or ($mru{geometry}{width} < 0));
  $top -> geometry($location);
};

$top -> deiconify;
$top -> raise;
$container -> pack(-fill=>'both', -side=>$config{general}{fatside}, -expand=>0);
$container -> packPropagate(0);

## if ($is_windows) {
##   open PARID, ">".$groups{"Default Parameters"} -> find('athena', 'par');;
##   print PARID $ENV{PAR_TEMP}, $/;
##   close PARID;
## };

## process the command line argument
if ($ARGV[0]) {
 CMDARG: {
    (-d $ARGV[0]) and do {	# directory: open extended selection file dialog
      $current_data_dir = $ARGV[0];
      &read_file(1, 0);
      last CMDARG;
    };
    ($ARGV[0] =~ /^-(\d+)$/) and do { # grab something from the MRU list
      &read_file(0, $mru{mru}{$1}) if (exists $mru{mru}{$1} and (-e $mru{mru}{$1}));
      last CMDARG;
    };
    (-e $ARGV[0]) and do {	# open the specified file or project
      my $arg = ($ARGV[0] =~ /^[.\~\/]/) ? $ARGV[0] : File::Spec->catfile(Cwd::cwd, $ARGV[0]);
      &read_file(0, $arg);
      last CMDARG;
    };
  }; # end of CMDARG
};



MainLoop();
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2008 Bruce Ravel
##
##  This section of the code contains the subroutine for dealing with
##  the Group list in the skinny frame


sub fill_skinny {

  my ($list, $item, $is_file, $dont_set) = @_;
  my $list_canvas = ($list->children())[0];
  #my ($group, $label) = group_name($item);
  my ($group, $label) = ($groups{$item}->{group}, $groups{$item}->{label});
  my $vio = $config{colors}{marked};

  ## begin drawing widgets on the skinny canvas

  ## the values for widget placement were determined by trial and error
  my $step = $config{list}{real_y}; # see delete_group in group_ops.pl
  my ($cx, $cy, $tx, $ty) = ($config{list}{real_x1}.'c',
			     sprintf("%4.2fc",1.1+$step*$line_count),
			     $config{list}{real_x2}.'c',,
			     sprintf("%4.2fc",1.1+$step*$line_count));

  ($is_file) and ($marked{$group} = 0);
  ++$group_count;
  my $tag = sprintf("line_%d", $group_count); # checkbutton for marking groups
  $groups{$item}->make(bindtag=>$tag);
  my $checkbutton;
  if ($is_file) {
    $checkbutton = $list -> Checkbutton(-selectcolor=>$vio, -variable => \$marked{$group},);
  } else {
    $checkbutton = $list -> Frame(qw/-width 18p -height 10p -borderwidth 0/);
  };
  my $check = $list -> createWindow($cx, $cy, -anchor=>'e', -window => $checkbutton);
  ## change text size/color unless passing over the current group
  ## (this works because the text has only one tag associated with it,
  ## which is the first item in the list returned by the itemcget method.
  ## Take care not to undo the orange group.  The rectangle is below the text.
  my @bold     = (-fill => $config{colors}{activehighlightcolor}, );
  my @normal   = (-fill => $config{colors}{foreground}, );
  my @rect_in  = (-fill => $config{colors}{activebackground}, -outline=>$config{colors}{activebackground});
  my @rect_out = (-fill => $config{colors}{background},       -outline=>$config{colors}{background});
  $list -> bind($tag, '<Any-Enter>'=>sub{my $this = shift;
					 return if not exists($groups{$current}->{bindtag});
					 $this->configure(-cursor => $mouse_over_cursor);
					 if ($this->itemcget('current', '-tags')->[0] ne $groups{$current}->{bindtag}) {
					   #$this->itemconfigure('current', @bold  );
					   my $x = $this->find(below=>'current');
					   $this->itemconfigure($x, @rect_in,);
					 }
				       });
  $list -> bind($tag, '<Any-Leave>'=>\&Leave);
## 		sub{my $this = shift;
## 					 return if not exists($groups{$current}->{bindtag});
## 					 if ($this->itemcget('current', '-tags')->[0] ne $groups{$current}->{bindtag}) {
## 					   my $x = $this->find(below=>'current');
## 					   $this->itemconfigure($x, @rect_out,);
## 					 };
## 				       }
  ## this rectangle is colored to indicate the selected group
  ## write the name of the group over the rectangle
  my $text = $list -> createText($tx, $ty, -anchor=>'w', -text=>$label, -tags=>$tag,
				 -font => $config{fonts}{med});
  ## see set_properties for how this rectangle is managed
  my $rect = $list -> createRectangle($list->bbox($text), #$tx1, $ty1, $tx2, $ty2,
				      -width=>5,
				      -fill=>$config{colors}{background},
				      -outline=>$config{colors}{background});
  $list_canvas->raise($text, $rect);

  ## set a few features of the data object that Athena uses to display
  ## the data
  $groups{$group} -> make(check=>$check, rect=>$rect, text=>$text, checkbutton=>$checkbutton);
  ## deal with the element and edge symbols
  if (not $reading_project) {
    if ($groups{$group}->{is_pixel}) {
      $groups{$group} -> make(bkg_z=>'H', fft_edge=>'K',);
    } elsif ($groups{$group}->{not_data}) {
      1;
    } elsif (lc($groups{$group}->{bkg_z}) eq 'h') {
      my ($sym, $edg) = find_edge($groups{$group}->{bkg_e0});
      $groups{$group} -> make(bkg_z=>$sym, fft_edge=>$edg,);
    };
    ## adjust e0 if configured for half-step, zero crossing, or atomic
    if ($config{bkg}{e0} eq 'fraction') {
      $groups{$group} -> dispatch_bkg($dmode);
      set_edge($group, 'fraction');
    } elsif ($config{bkg}{e0} eq 'zero') {
      $groups{$group} -> dispatch_bkg($dmode);
      set_edge($group, 'zero');
    } elsif ($config{bkg}{e0} eq 'atomic') {
      Echo("Cannot fetch atomic e0 values."), return unless $absorption_exists;
      $groups{$group} -> dispatch_bkg($dmode);
      set_edge($group, 'atomic');
    };
    set_edge_peak($group) if (    $config{bkg}{ledgepeak}
			      and get_Z($config{bkg}{ledgepeak})
			      and (get_Z($groups{$group}->{bkg_z}) > get_Z($config{bkg}{ledgepeak}))
			      and ($groups{$group}->{fft_edge} =~ m{l[23]}i)
			     );
  };
  $groups{$group} -> make(bkg_eshift=>0) unless ($groups{$group}->{bkg_eshift} =~ /-?(\d+\.?\d*|\.\d+)/);
  $groups{$group} -> make(bkg_nclamp	=> $config{bkg}{nclamp},
			  bkg_tie_e0	=> 0,
			  bkg_former_e0	=> $groups{$group}->{bkg_e0});

  ## adjust view so this one is showing
  push @skinny_list, $check, $rect, $text;
  my $h = ($list->bbox(@skinny_list))[3] + 5;
  if ($h > 200) {
    $list -> configure(-scrollregion=>['0', '0', '200', $h]);
    $list -> yview('moveto', 1);
  };

  ## mouse bindings in the groups list
  #$list -> bind($tag, '<Double-Button-1>' => sub{set_properties($group, 0); &get_new_name;});
  $list -> bind($tag, '<Double-Button-1>' => sub{set_properties(1, $group, 0); $list_canvas->focus; &get_new_name;});
  $list -> bind($tag, '<1>' => [\&set_properties, $group, 0]);
  $list -> bind($tag, '<2>' => sub{$marked{$group} = !$marked{$group}});
  ($is_file) and
    $list -> bind($tag, '<3>' => [\&GroupsPopupMenu, $group, Ev('X'), Ev('Y')]);

  ## finally, fill parameters into the fat canvas
  set_properties(1, $group, 0) unless $dont_set;
  project_state(0);
};


## END OF GROUP LIST SUBSECTION
##########################################################################################


## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2009 Bruce Ravel
##
##  This section of the code contains subroutines for drawing the
##  frame which contains all the parameters of the selected group


## This is just a lot of boring layout of widgets.  It's some really
## dense, repititious, and uninteresting code.

sub draw_properties {
  #my $c = $_[0];
  my $frame = $_[0];
  my ($f_label, $f_text, $f_bold, $f_tiny) = ($config{fonts}{bold},
					      $config{fonts}{small},
					      $config{fonts}{small},
					      $config{fonts}{tiny});
  my $bigtextcolor = $config{colors}{activehighlightcolor};
  my ($t, $y) = ("", '0.4c');
  my @rectangle = ("-fill",    $config{colors}{background},
		   "-outline", $config{colors}{background},
		   "-width", 3);

  my $gap = 10;
  my $jump = 0;
  $y = 7;


  ## ============================================================================
  ## ============================================================================
  ## projectbar
  my $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c/,
			  -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $widget{main_canvas} = $c;
  my @bbox_list = ();
  $props{project} = $c;
  my $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>3);
  $header{project} = $box -> Label(-text=>"  Project",
				   -foreground=>$bigtextcolor,
				   -font=>$f_label)
    -> pack(-side=>'left');
  &group_click($header{project}, 'project');
  my $project_label = $box -> Label(-textvariable => \$project_name,
				    -width	  => 1,
				    #-justify	  => 'right',
				    -anchor       => 'e')
    -> pack(-side=>'left', -padx=>12, -expand=>1, -fill=>'x');


  ## Current group section
  $c = $frame -> Frame(qw(-relief ridge -borderwidth 2 -width 12.5c),
		       -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill x/); #disable_mouse_wheel($c);
  $props{current} = $c;
  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>3);
  $header{current} = $box -> Label(-text       => "  Current group",
				   -foreground => $bigtextcolor,
				   -font       => $f_label)
    -> pack(-side=>'left');
  &group_click($header{current}, 'current');
  $widget{current} = $box -> Entry(-width=>30, -relief=>'flat', -font=>$f_bold,
				   -foreground=>$config{colors}{button},
				   (($Tk::VERSION >= 804) ? (-disabledforeground=>$config{colors}{button}) : ()),
				   -state=>'disabled')
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>12);
  ## not displaying the ifeffit data group
  $widget{group} = $box -> Entry(-width=>10, -relief=>'flat', -font=>$f_bold,
			       -foreground=>$config{colors}{button},
			       -state=>'disabled');
  ##  -> pack(-side=>'left', -expand=>1, -fill=>'x');



  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>3);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"File:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,0);
  $widget{file} = $box -> Entry(-width=>45, -state=>'disabled', -relief=>'groove',
				-foreground=>$config{colors}{foreground},
				(($Tk::VERSION >= 804) ? (-disabledforeground=>$config{colors}{foreground}) : ()),
			       )
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>6);



  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>3);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"Z: ",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_z');
  $widget{z} = $box -> Optionmenu(-font=>$config{fonts}{small},
				  -textvariable => \$menus{bkg_z},
				  -borderwidth=>1, -state=>'disabled',
				 )
    -> pack(-side=>'left', -padx=>6);
  my $last = 90;
  while ($last < 104) {
    last unless (Xray::Absorption->in_resource($last));
    ++$last;
  };
  --$last;
  foreach my $l ([1..20], [21..40], [41..60], [61..80], [81..$last]) {
    my $cas = $widget{z} ->
      cascade(-label => get_symbol($$l[0]) . " (" . $$l[0] . ") to " . get_symbol($$l[-1]) . " (" .  $$l[-1] . ") ",
	      -tearoff=>0 );
    foreach my $i (@$l) {
      $cas -> command(-label => $i . ": " . get_symbol($i),
		      -command=>
		      sub{$menus{bkg_z}=get_symbol($i);
			  if ($groups{$current}->{frozen}) {
			    $menus{bkg_z}=$groups{$current}->{bkg_z};
			    return;
			  };
			  $groups{$current}->make(bkg_z=>$menus{bkg_z},
						  update_bkg=>1);
			  #
			  if ($groups{$current}->{reference} and $groups{$current}->{refsame}) {
			    $groups{$groups{$current}->{reference}}->make(bkg_z=>$menus{bkg_z},
			  						  update_bkg=>1);
			   };
			  #$groups{$current} ->
			  #  plotE('emzn',$dmode,\%plot_features, \@indicator);
			  project_state(0);
			});
    };
  };
  $t = $box -> Label(-text=>"Edge:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_edge');
  $menus{fft_edge} = 'K';
  $widget{edge} = $box -> Optionmenu(-font=>$config{fonts}{small},
				   -borderwidth=>1, -state=>'disabled',
				   -textvariable => \$menus{fft_edge},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i (qw(K L1 L2 L3 M1 M2 M3 M4 M5)) {
    $widget{edge} -> command(-label => $i,
			     -command=>
			     sub{$menus{fft_edge}=$i;
				 if ($groups{$current}->{frozen}) {
				   $menus{fft_edge}=$groups{$current}->{fft_edge};
				   return;
				 };
				 $groups{$current}->make(fft_edge=>$menus{fft_edge},
							 update_fft=>1);
				 if ($groups{$current}->{reference} and $groups{$current}->{refsame}) {
				   $groups{$groups{$current}->{reference}}->make(fft_edge=>$menus{fft_edge},
										 update_bkg=>1);
				 };
				 project_state(0);
			       });
  };

  $t = $box -> Label(-text=>"E shift:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
 &click_help($t,'bkg_eshift');
  $widget{bkg_eshift} = $box -> Entry(-width=>5, -font=>$config{fonts}{entry},
				    -validate=>'key', -validatecommand=>[\&set_variable, 'bkg_eshift'])
    -> pack(-side=>'left', -padx=>6);


  $t = $box -> Label(-text=>"Importance:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
 &click_help($t,'importance');
  $widget{importance} = $box -> Entry(-width=>4,
				    -font=>$config{fonts}{entry},
				    #-disabledforeground=>$config{colors}{disabledforeground},
				    -validate=>'key',
				    -validatecommand=>[\&set_variable, 'importance'])
    -> pack(-side=>'left', -padx=>6);

  #$box = $c -> Frame() -> pack(-side=>'top', -fill=>'y', -expand=>1);


  ## Background Removal section
  $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c/, # -height 7.0c/,
		       -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $props{bkg} = $c;

  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>3);
  $header{bkg} = $box -> Label(-text=>"  Background removal",
			       -foreground=>$bigtextcolor,
			       -font=>$f_label)
    -> pack(-side=>'left');

  &group_click($header{bkg}, 'bkg');
  $widget{bkg_switch} = $box -> Button(-text=>"Show additional parameters",
				     -font=>$config{fonts}{small},
				     -borderwidth=>1,
				     -command => sub {
				       $props{bkg}->packForget;
				       $props{bkg_secondary} -> pack(qw/-expand 1 -fill both -after/, $props{current});
				     })
    -> pack(-side=>'right', -padx=>12);

  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"E0:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_e0');
  $widget{bkg_e0} = $box -> Entry(-width=>8, -validate=>'all', -font=>$config{fonts}{entry},
				  -validatecommand=>[\&set_variable, 'bkg_e0'])
    -> pack(-side=>'left', -padx=>6);
  $grab{bkg_e0} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_e0'])
    -> pack(-side=>'left');

  $t = $box -> Label(-text=>"",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left', -padx=>10);
  $t = $box -> Label(-text=>"Rbkg:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_rbkg');
  $widget{bkg_rbkg} = $box -> RetEntry(-width=>4,
				       -font=>$config{fonts}{entry},
				       -command=>\&autoreplot,
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_rbkg'])
    -> pack(-side=>'left', -padx=>6);
  $grab{bkg_rbkg} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_rbkg'])
    -> pack(-side=>'left');

  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"k-weight:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_kw');
  $widget{bkg_kw} = $box -> RetEntry(-width=>3,
				     -font=>$config{fonts}{entry},
				     #-disabledforeground=>$config{colors}{disabledforeground},
				     -command=>\&autoreplot,
				     -validate=>'key',
				     -validatecommand=>[\&set_variable, 'bkg_kw'])
    -> pack(-side=>'left', -padx=>6);

  $t = $box -> Label(-text=>"Edge step:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,0);
  $widget{bkg_step} = $box -> NumEntry(-width      => 7,
				       -font       => $config{fonts}{entry},
				       -orient     => 'horizontal',
				       -foreground => $config{colors}{foreground},
				       -increment  => $config{bkg}{step_increment},
				       -browsecmd  => sub{$menus{bkg_fixstep}=1;
							  $groups{$current}->make(bkg_step=>$widget{bkg_step}->cget('-value'),
										  bkg_fixstep=>$menus{bkg_fixstep},
										  update_bkg=>1);
							  project_state(0);
							},
				       -command    => sub{$menus{bkg_fixstep}=1;
							  $groups{$current}->make(bkg_step=>$widget{bkg_step}->cget('-value'),
										  bkg_fixstep=>$menus{bkg_fixstep},
										  update_bkg=>1);
							  project_state(0);
							  autoreplot();
							},
				       #-textvariable=>\$$rhash{$s}{$v}{new},
				       #-validate=>'key',
				       #-validatecommand=>[\&set_variable, 'bkg_step']
				      )
    -> pack(-side=>'left', -padx=>6);
  $widget{bkg_fixstep} = $box -> Checkbutton(-text	  => 'fix step',
					     -onvalue	  => 1,
					     -offvalue	  => 0,
					     -font	  => $f_text,
					     -selectcolor => $config{colors}{single},
					     -variable	  => \$menus{bkg_fixstep},
					     -command	  =>
					     sub{$groups{$current}->
						   make(bkg_step	  => $widget{bkg_step}->cget('-value'),
							bkg_fixstep => $menus{bkg_fixstep},
							update_bkg  => 1);
						 project_state(0);
						 ##$widget{bkg_step} -> configure(-state=>($menus{bkg_fixstep}) ? 'disabled' : 'normal');
					       })
    -> pack(-side=>'left', -padx=>6);



  ##   $t = $c -> createText('5.0c', $y, -anchor=>'w', -text=>"dk: ",
  ## 			-fill=>'black', -font=>$f_text);
  ##   &click_help($t,'bkg_dk');
  ##   $widget{bkg_dk} = $c -> RetEntry(-width=>5, -validate=>'key',
  ##                            -font=>$config{fonts}{entry},
  ## 				-validatecommand=>[\&set_variable, 'bkg_dk']);
  ##   $c -> createWindow('6.0c', $y, -anchor=>'w', -window => $widget{bkg_dk});
  ##   $t = $c -> createText('8.0c', $y, -anchor=>'w', -text=>"window type:",
  ## 			-fill=>'black', -font=>$f_text);
  ##   &click_help($t,'bkg_win');
  ##   $widget{bkg_win} = $c -> Optionmenu(-font=>$config{fonts}{small},
  ##                                         -textvariable => \$menus{bkg_win},);
  ##   foreach my $i ($setup->Windows) {
  ##     $widget{bkg_win} -> command(-label => $i,
  ## 				-command=>sub{$menus{bkg_win}=$i;
  ## 					      project_state(0);
  ## 					      $groups{$current}->make(bkg_win=>$i,
  ## 								      update_bkg=>1)});
  ##   };
  ##   $c -> createWindow('10.9c', $y, -anchor=>'w', -window => $widget{bkg_win});

  # pre edge
  $box = $c -> Frame() -> pack(-side=>'top', -pady=>2, -anchor=>'w');
  $box -> Label(-text=>"     ")
    -> grid(-row=>0, -column=>0, -sticky=>'w', -ipady=>1);
  $t = $box -> Label(-text=>"Pre-edge range:", -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> grid(-row=>0, -column=>1, -columnspan=>2, -sticky=>'w');
  &click_help($t,'bkg_pre1','bkg_pre2');
  $widget{bkg_pre1} = $box -> RetEntry(-width=>8,
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -font=>$config{fonts}{entry},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_pre1'])
    -> grid(-row=>0, -column=>3, -sticky=>'w');
  $grab{bkg_pre1} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_pre1'])
    -> grid(-row=>0, -column=>4, -sticky=>'w', -padx=>2);
  $box -> Label(-text=>"to",
	      -foreground=>'black', -font=>$f_text)
    -> grid(-row=>0, -column=>5, -sticky=>'ew', -ipadx=>5);
  $widget{bkg_pre2} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_pre2'])
    -> grid(-row=>0, -column=>6, -sticky=>'ew');
  $grab{bkg_pre2} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_pre2'])
    -> grid(-row=>0, -column=>7, -sticky=>'w', -padx=>2);

				# normalization
  $box -> Label(-text=>"     ")
    -> grid(-row=>1, -column=>0, -sticky=>'ew', -ipady=>1);
  $t = $box -> Label(-text=>"Normalization range:", -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> grid(-row=>1, -column=>1, -columnspan=>2, -sticky=>'w');
  &click_help($t,'bkg_nor1','bkg_nor2');
  $widget{bkg_nor1} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_nor1'])
    -> grid(-row=>1, -column=>3, -sticky=>'ew');
  $grab{bkg_nor1} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_nor1'])
    -> grid(-row=>1, -column=>4, -sticky=>'w', -padx=>2);
  $box -> Label(-text=>"to",
		-foreground=>'black', -font=>$f_text)
    -> grid(-row=>1, -column=>5, -sticky=>'ew', -ipadx=>5);
  $widget{bkg_nor2} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_nor2'])
    -> grid(-row=>1, -column=>6, -sticky=>'ew');
  $grab{bkg_nor2} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_nor2'])
    -> grid(-row=>1, -column=>7, -sticky=>'w', -padx=>2);

				# spline k
  $box -> Label(-text=>"     ")
    -> grid(-row=>2, -column=>0, -sticky=>'ew', -ipady=>1);
  $t = $box -> Label(-text=>"Spline range:", -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> grid(-row=>2, -column=>1, -sticky=>'w');
  &click_help($t,'bkg_spl1','bkg_spl2');
  $t = $box -> Label(-text=>"k: ", -anchor=>'e',
		     -foreground=>'black', -font=>$f_text)
    -> grid(-row=>2, -column=>2, -sticky=>'e');
  &click_help($t,'bkg_spl1','bkg_spl2');
  $widget{bkg_spl1} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_spl1'])
    -> grid(-row=>2, -column=>3, -sticky=>'ew');
  $grab{bkg_spl1} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_spl1'])
    -> grid(-row=>2, -column=>4, -sticky=>'w', -padx=>2);
  $box -> Label(-text=>"to",
		-foreground=>'black', -font=>$f_text)
    -> grid(-row=>2, -column=>5, -sticky=>'ew', -ipadx=>5);
  $widget{bkg_spl2} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>\&autoreplot,
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bkg_spl2'])
    -> grid(-row=>2, -column=>6, -sticky=>'ew');
  $grab{bkg_spl2} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_spl2'])
    -> grid(-row=>2, -column=>7, -sticky=>'w', -padx=>2);

				# spline E
  $box -> Label(-text=>"     ")
    -> grid(-row=>3, -column=>0, -sticky=>'ew', -ipady=>1);
  $t = $box -> Label(-text=>"E: ", -anchor=>'e',
		     -foreground=>'black', -font=>$f_text)
    -> grid(-row=>3, -column=>2, -sticky=>'e');
  &click_help($t,'bkg_spl1e','bkg_spl2e');
  $widget{bkg_spl1e} = $box -> RetEntry(-width=>8,
					-font=>$config{fonts}{entry},
					#-disabledforeground=>$config{colors}{disabledforeground},
					-command=>\&autoreplot,
					-validate=>'key',
					-validatecommand=>[\&set_variable, 'bkg_spl1e'])
    -> grid(-row=>3, -column=>3, -sticky=>'w');
  $grab{bkg_spl1e} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_spl1e'])
    -> grid(-row=>3, -column=>4, -sticky=>'w', -padx=>2);
  $box -> Label(-text=>"to",
		-foreground=>'black', -font=>$f_text)
    -> grid(-row=>3, -column=>5, -sticky=>'ew');
  $widget{bkg_spl2e} = $box -> RetEntry(-width=>8,
					#-disabledforeground=>$config{colors}{disabledforeground},
					-validate=>'key',
					-command=>\&autoreplot,
					-font=>$config{fonts}{entry},
					-validatecommand=>[\&set_variable, 'bkg_spl2e'])
    -> grid(-row=>3, -column=>6, -sticky=>'w');
  $grab{bkg_spl2e} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bkg_spl2e'])
    -> grid(-row=>3, -column=>7, -sticky=>'w', -padx=>2);


  ## secondary background parameters
  $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c/, # -height 7.0c/,
			   -highlightcolor=>$config{colors}{background});
#    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $props{bkg_secondary} = $c;


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $header{bkg_secondary} = $box -> Label(-text=>"  Background removal",
					 -foreground=>$bigtextcolor,
					 -font=>$f_label)
    -> pack(-side=>'left');
  &group_click($header{bkg_secondary}, 'bkg');
  $widget{bkg_switch2} = $box -> Button(-text=>"Show main parameters",
					-font=>$config{fonts}{small},
					-borderwidth=>1,
					-command => sub{
					  $props{bkg_secondary}->packForget;
					  $props{bkg} -> pack(qw/-expand 1 -fill both -after/, $props{current});
					})
    -> pack(-side=>'right', -padx=>12);



  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $widget{bkg_flatten} = $box -> Checkbutton(-text	  => 'Flatten normalized data',
					     -onvalue	  => 1,
					     -offvalue	  => 0,
					     -font	  => $f_text,
					     -selectcolor => $config{colors}{single},
					     -variable	  => \$menus{bkg_flatten},
					     -command	  =>
					     sub{$groups{$current}->
						   make(bkg_flatten=>$menus{bkg_flatten});
						 autoreplot('e');
						 project_state(0)})

    -> pack(-side=>'left');
  $widget{bkg_flatten} -> bind('<ButtonPress-3>' =>
			       sub{return 0 unless ($current);
				   return 0 unless (scalar keys %groups > 1);
				   my $is_active = ($widget{bkg_flatten}->cget('-state') ne 'disabled');
				   return 0 unless $is_active;
				   my $menu=$top->Menu(-tearoff=>0,
						       -menuitems=>[["command"=>"Set all groups to this value of flatten",
								     -command => sub{&set_params('all', 'bkg_flatten')},
								     -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								    ],
								    ["command"=>"Set marked groups to this value of flatten",
								     -command => sub{&set_params('marked', 'bkg_flatten')},
								     -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								    ],
								    "-",
								    ["command"=>"Set this value of flatten to the standard",
								     -command => sub{&set_params('this', 'bkg_flatten')},
								     -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								    ],
								   ]);
				   $menu -> Popup(-popover=>'cursor', -popanchor=>'w');
				 });
 ##&click_help($t,'bkg_flatten');
  $t = $box -> Label(-text=>"   ",
		     -foreground=>'black',
		     -font=>$f_text)
    -> pack(-side=>'left');

  $menus{bkg_alg} = 'Autobk'; ####!!!!!
  $t = $box -> Label(-text=>"Background:",
		   -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_alg');
  $widget{bkg_alg} = $box -> Optionmenu(-font=>$config{fonts}{small},
					-borderwidth=>1,
					-textvariable => \$menus{bkg_alg},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i ('Autobk', 'CLnorm') {
    $widget{bkg_alg} -> command(-label => $i,
				-command=>
				sub{$menus{bkg_alg}=$i;
				    if ($groups{$current}->{frozen}) {
				      $menus{bkg_alg}='Autobk';
				      $menus{bkg_alg}='CLnorm' if $groups{$current}->{bkg_cl};
				      return;
				    };
				    ## flatten should be off when CL
				    ## is on
				    if ($menus{bkg_alg} ne 'Autobk') {
				      $groups{$current}->{bkg_flatten_was} = $groups{$current}->{bkg_flatten};
				    };
				    $menus{bkg_flatten} = ($menus{bkg_alg} eq 'Autobk') ? $groups{$current}->{bkg_flatten_was} : 0;
				    $groups{$current} ->
				      make(bkg_cl      => ($menus{bkg_alg} eq 'Autobk') ? 0 : 1,
					   bkg_flatten => ($menus{bkg_alg} eq 'Autobk') ? $groups{$current}->{bkg_flatten_was}  : 0,
					   bkg_z       => $menus{bkg_z},
					   update_bkg  => 1);
		 		    ## disable widgets not needed by
		 		    ## the selected background algorithm
				    #$widget{bkg_z} ->
				    #  configure(-state=>($menus{bkg_alg} eq 'Autobk')
				    #	? 'disabled' : 'normal');
				    ##  dk win
				    foreach (qw(stan rbkg kw spl1 spl2 spl1e spl2e flatten)) {
				      $widget{'bkg_'.$_} ->
					configure(-state=>($menus{bkg_alg} eq 'CLnorm')
						  ? 'disabled' : 'normal');
				    };
				    foreach (qw(rbkg spl1 spl2 spl1e spl2e)) {
				      $grab{'bkg_'.$_} ->
					configure(-state=>($menus{bkg_alg} eq 'CLnorm')
						  ? 'disabled' : 'normal');
				    };
				    ## make a plot
				    project_state(0);
				    #if ($menus{bkg_alg} eq 'CLnorm') {
				    #  if (lc($menus{bkg_z}) eq 'h') {
				    #	&z_popup($current, 'cl');
				    #      } else {
				    #	&z_popup($current, 'cl,update');
				    #  };
				    #};
				    #($menus{bkg_alg} eq 'Autobk') and
				    $groups{$current}->plotE('emz',$dmode,\%plot_features, \@indicator);;
				  }
			       );
  };



  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"Normalization order:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_nnorm1');
  foreach my $i (1,2,3) {
    my $this = "bkg_nnorm".$i;
    $widget{$this} = $box -> Radiobutton(-text        => "$i",
					 -value       => $i,
					 -selectcolor => $config{colors}{single},
					 -font	      => $f_text,
					 -variable    => \$menus{bkg_nnorm},
					 -command     => sub{$groups{$current}->
							       make(bkg_nnorm=>$menus{bkg_nnorm},
								    update_bkg=>1);
							     autoreplot('e');
							     project_state(0)})
      -> pack(-side=>'left', -padx=>3);
  };


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $widget{bkg_fnorm} = $box -> Checkbutton(-text	      => 'Use functional normalization',
					   -onvalue     => 1,
					   -offvalue    => 0,
					   -selectcolor => $config{colors}{single},
					   -font	=> $f_text,
					   -variable    => \$menus{bkg_fnorm},
					   -command     =>
					   sub{$groups{$current}->
						 make(bkg_fnorm=>$menus{bkg_fnorm});
					       autoreplot('e');
					       project_state(0)})
    -> pack(-side=>'left');
  $widget{bkg_fnorm} -> bind('<ButtonPress-3>' =>
			     sub{return 0 unless ($current);
				 return 0 unless (scalar keys %groups > 1);
				 my $is_active = ($widget{bkg_fnorm}->cget('-state') ne 'disabled');
				 return 0 unless $is_active;
				 my $menu=$top->Menu(-tearoff=>0,
						     -menuitems=>[["command"=>"Set all groups to use functional normalization",
								   -command => sub{&set_params('all', 'bkg_fnorm')},
								   -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								  ],
								  ["command"=>"Set marked groups to use functional normalization",
								   -command => sub{&set_params('marked', 'bkg_fnorm')},
								   -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								  ],
								  "-",
								  ["command"=>"Set use of functional normalization to the standard",
								   -command => sub{&set_params('this', 'bkg_fnorm')},
								   -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
								  ],
								 ]);
				 $menu -> Popup(-popover=>'cursor', -popanchor=>'w');
			       });


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"Standard:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_stan');
  $widget{bkg_stan} = $box -> BrowseEntry(-variable=>\$menus{bkg_stan_lab},
					  -width=>30,
					  @browseentry_list,
					  -browsecmd => sub {
					    my $text = $_[1];
					    my $this = $1 if ($text =~ /^(\d+):/);
					    Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless defined($this);
					    #$this -= 1;
					    project_state(0);
					    my $x = $menus{keys}->[$this];
					    $groups{$x}->dispatch_bkg($dmode) if
					      $groups{$x}->{update_bkg};
					    $groups{$current}->make(bkg_stan=>$menus{keys}->[$this],
								    bkg_stan_lab=>$groups{$x}->{label},
								    update_bkg=>1);
					    autoreplot('e')
					  })
    -> pack(-side=>'left', -padx=>6);




				# clamps
  $menus{bkg_clamp1} = 'None';
  $menus{bkg_clamp2} = 'Strong';
  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"Spline clamps:  ",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t);
  $t = $box -> Label(-text=>"low:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_clamp1');
  $widget{bkg_clamp1} = $box -> Optionmenu(-font=>$config{fonts}{small},
					   -borderwidth=>1,
					   -textvariable => \$menus{bkg_clamp1},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i (qw(None Slight Weak Medium Strong Rigid)) {
    $widget{bkg_clamp1} -> command(-label => $i,
				  -command=>sub{$menus{bkg_clamp1}=$i;
						if ($groups{$current}->{frozen}) {
						  $menus{bkg_clamp1}=$groups{$current}->{bkg_clamp1};
						  return;
						};
						project_state(0);
						$groups{$current}->make(bkg_clamp1=>$i,
									update_bkg=>1);
						autoreplot('e') });
  };

  $t = $box -> Label(-text=>"high:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bkg_clamp2');
  $widget{bkg_clamp2} = $box -> Optionmenu(-font=>$config{fonts}{small},
					   -borderwidth=>1,
					   -textvariable => \$menus{bkg_clamp2},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i (qw(None Slight Weak Medium Strong Rigid)) {
    $widget{bkg_clamp2} -> command(-label => $i,
				  -command=>sub{$menus{bkg_clamp2}=$i;
						if ($groups{$current}->{frozen}) {
						  $menus{bkg_clamp2}=$groups{$current}->{bkg_clamp2};
						  return;
						};
						project_state(0);
						$groups{$current}->make(bkg_clamp2=>$i,
									update_bkg=>1);
						autoreplot('e')});
  };




  ## Forward transform section
  $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c/, # -height 3.3c/,
			   -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $header{fft} = $box -> Label(-text=>"  Forward Fourier transform",
			       -foreground=>$bigtextcolor,
			       -font=>$f_label)
    -> pack(-side=>'left');
  $props{fft} = $c;
  &group_click($header{fft}, 'fft');

  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"k-range:", -width=>9, -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_kmin','fft_kmax');
  $widget{fft_kmin} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>[\&autoreplot,'r'],
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'fft_kmin'])
    -> pack(-side=>'left', -padx=>6);
  $grab{fft_kmin} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'fft_kmin'])
    -> pack(-side=>'left');
  $box -> Label(-text=>"  to ",
		-foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  $widget{fft_kmax} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>[\&autoreplot,'r'],
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'fft_kmax'])
    -> pack(-side=>'left', -padx=>6);
  $grab{fft_kmax} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'fft_kmax'])
    -> pack(-side=>'left');


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"dk: ", -width=>4, -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_dk');
  $widget{fft_dk} = $box -> RetEntry(-width=>5,
				     -font=>$config{fonts}{entry},
				     #-disabledforeground=>$config{colors}{disabledforeground},
				     -command=>[\&autoreplot,'r'],
				     -validate=>'key',
				     -validatecommand=>[\&set_variable, 'fft_dk'])
    -> pack(-side=>'left', -padx=>6);
  $t = $box -> Label(-text=>"window type:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_win');
  $widget{fft_win} = $box -> Optionmenu(-font=>$config{fonts}{small},
					-borderwidth=>1,
					-textvariable => \$menus{fft_win},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i ($setup->Windows) {
    $widget{fft_win} -> command(-label => $i,
				-command=>sub{$menus{fft_win}=$i;
					      if ($groups{$current}->{frozen}) {
						$menus{fft_win}=$groups{$current}->{fft_win};
						return;
					      };
					      project_state(0);
					      $groups{$current}->make(fft_win=>$i,
								      update_fft=>1);
					      autoreplot('r')});
  };


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"Phase correction:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_pc');
  $menus{fft_pc} = 'off';
  $widget{fft_pc} =
    $box -> Checkbutton(-selectcolor	  => $config{colors}{single},
			-activebackground => $config{colors}{background},
			-font		  => $f_text,
			-variable	  => \$menus{fft_pc},
			-textvariable	  => \$menus{fft_pc},
			-onvalue	  => 'on',
			-offvalue         => 'off',
			-command	  =>
			sub{$groups{$current}->make(fft_pc=>$menus{fft_pc}, update_fft=>1);
			    if ($menus{fft_pc} eq 'on') {
			      &z_popup($current, 'pc') if (lc($menus{bkg_z}) eq 'h');
			      Echo("Doing central-atom phase-corrected Fourier transforms.");
			    } else {
			      Echo("Doing uncorrected Fourier transforms.");
			    };
			    project_state(0);
			  }
		       )
      -> pack(-side=>'left', -padx=>6);
  $t = $box -> Label(-text=>"arbitrary k-weight:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'fft_arbkw');
  $widget{fft_arbkw} = $box -> RetEntry(-width=>6,
					-font=>$config{fonts}{entry},
					#-disabledforeground=>$config{colors}{disabledforeground},
					-command=>[\&autoreplot, 'r'],
					-validate=>'key',
					-validatecommand=>[\&set_variable, 'fft_arbkw'])
    -> pack(-side=>'left', -padx=>6);


  ## Backward transform section
  $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c/, # -height 2.4c/,
		       -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $props{bft} = $c;
  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $header{bft} = $box -> Label(-text=>"  Backward Fourier transform",
			       -foreground=>$bigtextcolor,
			       -font=>$f_label)
    -> pack(-side=>'left');
  &group_click($header{bft}, 'bft');


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"R-range:", -width=>9, -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bft_rmin','bft_rmax');
  $widget{bft_rmin} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>[\&autoreplot, 'q'],
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bft_rmin'])
    -> pack(-side=>'left', -padx=>6);
  $grab{bft_rmin} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bft_rmin'])
    -> pack(-side=>'left');
  $box -> Label(-text=>"  to ",
		-foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  $widget{bft_rmax} = $box -> RetEntry(-width=>8,
				       -font=>$config{fonts}{entry},
				       #-disabledforeground=>$config{colors}{disabledforeground},
				       -command=>[\&autoreplot, 'q'],
				       -validate=>'key',
				       -validatecommand=>[\&set_variable, 'bft_rmax'])
    -> pack(-side=>'left', -padx=>6);
  $grab{bft_rmax} = $box -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'bft_rmax'])
    -> pack(-side=>'left');


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"dr: ", -width=>4, -anchor=>'w',
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bft_dr');
  $widget{bft_dr} = $box -> RetEntry(-width=>5,
				     -font=>$config{fonts}{entry},
				     #-disabledforeground=>$config{colors}{disabledforeground},
				     -command=>[\&autoreplot, 'q'],
				     -validate=>'key',
				     -validatecommand=>[\&set_variable, 'bft_dr'])
    -> pack(-side=>'left', -padx=>6);
  $t = $box -> Label(-text=>"window type:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'bft_win');
  $widget{bft_win} = $box -> Optionmenu(-font=>$config{fonts}{small},
					-borderwidth=>1,
					-textvariable => \$menus{bft_win},)
    -> pack(-side=>'left', -padx=>6);
  foreach my $i ($setup->Windows) {
    $widget{bft_win} -> command(-label => $i,
				-command=>sub{$menus{bft_win}=$i;
					      if ($groups{$current}->{frozen}) {
						$menus{bft_win}=$groups{$current}->{bft_win};
						return;
					      };
					      project_state(0);
					      $groups{$current}->make(bft_win=>$i,
								      update_bft=>1);
					      autoreplot('q')});
  };


  ## Plot parameters
  $c = $frame -> Frame(qw/-relief ridge -borderwidth 2 -width 12.5c -height 1.4c/,
		       -highlightcolor=>$config{colors}{background})
    -> pack(qw/-expand 1 -fill both/);
#  disable_mouse_wheel($c);
  $props{plot} = $c;


  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $header{plot} = $box -> Label(-text=>"  Plotting parameters",
				-foreground=>$bigtextcolor,
				-font=>$f_label)
    -> pack(-side=>'left');
  &group_click($header{plot}, 'plot');

  $box = $c -> Frame() -> pack(-side=>'top', -fill=>'x', -expand=>1, -pady=>2);
  $box -> Label(-text=>"     ") -> pack(-side=>'left');
  $t = $box -> Label(-text=>"plot multiplier:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'plot_scale');
  $widget{plot_scale} = $box -> RetEntry(-width=>8,
					 -font=>$config{fonts}{entry},
					 #-disabledforeground=>$config{colors}{disabledforeground},
					 -command=>\&autoreplot,
					 -validate=>'key',
					 -validatecommand=>[\&set_variable, 'plot_scale'])
    -> pack(-side=>'left', -padx=>6);

  $t = $box -> Label(-text=>"y-axis offset:",
		     -foreground=>'black', -font=>$f_text)
    -> pack(-side=>'left');
  &click_help($t,'plot_yoffset');
  $widget{plot_yoffset} = $box -> RetEntry(-width=>8,
					   -font=>$config{fonts}{entry},
					   #-disabledforeground=>$config{colors}{disabledforeground},
					   -command=>\&autoreplot,
					   -validate=>'key',
					   -validatecommand=>[\&set_variable, 'plot_yoffset'])
    -> pack(-side=>'left', -padx=>6);

};


## Handle mouse-over functionality for labels in the main window
sub click_help {
  my $t = shift;
  my @keys = @_;


  ## ------ MOUSE OVER
  my @bold   = (-foreground => $config{colors}{foreground},
		-background => $config{colors}{activebackground},
		-font       => $config{fonts}{small},
	        -cursor     => $mouse_over_cursor);
  my @normal = (-foreground => $config{colors}{foreground},
		-background => $config{colors}{background},
		-font       => $config{fonts}{small});

  my @in     = (-fill    => $config{colors}{activebackground},
		-outline => $config{colors}{activebackground},);
  my @out    = (-fill    => $config{colors}{background},
		-outline => $config{colors}{background});
  $t -> bind('<Any-Enter>'=>sub{$t -> configure(@bold  ) });
  $t -> bind('<Any-Leave>'=>sub{$t -> configure(@normal) });


  ## ------ LEFT CLICK
  my $text = $t -> cget('-text');
  $text =~ s/\s+$//;
  my $str = $click_help{$text} || "$text ???";
  $t -> bind('<1>' => sub{Echo("$str")});



  ## a few parameters need additional items in their context menus
  my %extra = (
	       E0 => [[ command => "Set E0 to Ifeffit's default",
		       #-state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
		       -command => sub{set_edge($current, 'edge');     autoreplot('e');}],
		      [ command => "Set E0 to zero-crossing of 2nd derivative",
		       #-state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
		       -command => sub{set_edge($current, 'zero');     autoreplot('e');}],
		      [ command => "Set E0 to a set fraction of the edge step",
		       #-state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
		       -command => sub{set_edge($current, 'fraction'); autoreplot('e');}],
		      [ command => "Set E0 to atomic value",
		       #-state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
		       -command => sub{set_edge($current, 'atomic');   autoreplot('e');}],
		      [ command => "Set E0 to the peak of the white line",
		       #-state   => &wlbool($current),
		       -command => sub{autoreplot('e') if set_edge_peak($current);}],
		      "-",
		      [checkbutton  =>  'Tie energy and k values to E0   (Ctrl-T)',
		       -onvalue	    => 1,
		       -offvalue    => 0,
		       -selectcolor => $config{colors}{single},
		       -variable    => \$menus{bkg_tie_e0},
		       -command	    => \&tie_untie_e0,
		      ],
		     ],

	       'k-range' =>[[ command => "Set kmax to Ifeffit's suggestion",
			     #-state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
			     -command => sub{Echonow("Not changing kmax.  This group is frozen."), return if ($groups{$current}->{frozen});
					     $groups{$current}->dispatch_bkg if $groups{$current}->{update_bkg};
					     my @array = Ifeffit::get_array("$current.k");
					     $groups{$current}->MAKE(fft_kmax=>$array[-1]);
					     my $kx = sprintf("%.3f", $groups{$current}->kmax_suggest(\%plot_features));
					     project_state(0);
					     set_properties(1, $current, 0);
					     Echo("Set kmax to Ifeffit's suggested value of $kx");
					   },
			    ],
			   ],


	       Importance => [['command'=>"Set importance of all groups to 1",
			       -command=>sub{
				 foreach my $g (keys %marked) {
				   $groups{$g}->make(importance=>1);
				 }
				 set_properties(0,$current,0);
				 project_state(0);
			       }],
			      ['command'=>"Set importance of marked groups to 1",
			       -command=>sub{
				 foreach my $g (keys %marked) {
				   next unless $marked{$g};
				   $groups{$g}->make(importance=>1);
				 }
				 set_properties(0,$current,0);
				 project_state(0);
			       }]
			     ],

	       'E shift' => [[ command => "Identify reference channel",
			      -command => \&identify_reference,],
			     [ command => "Understanding the E shift",
			      -command => \&explain_eshift,],
			    ],
	      );


  ## ------ RIGHT CLICK
  if ($keys[0]) {
    ## need to treat z and edge specially
    ($keys[0] = 'z')    if ($keys[0] eq 'bkg_z');
    ($keys[0] = 'edge') if ($keys[0] eq 'fft_edge');
    $text =~ s/:$//;		# same text as left click
    ($text eq 'k')    and ($text = 'spline k-range');
    ($text eq 'E')    and ($text = 'spline E-range');
    ($text eq 'low')  and ($text = 'low-end spline clamp');
    ($text eq 'high') and ($text = 'high-end spline clamp');
    my $def_ok = not (($keys[0] =~ /^plot/) or
		      ($keys[0] =~ /^(edge|z)$/) or
		      ($keys[0] =~ /^bkg_(alg|eshift|e0|stan|step)/) or
		      ($text    eq 'E-range'));
    my $is_mee = ($keys[0] =~ m{^mee});
    $t -> bind('<3>' =>
	       sub{return 0 unless ($current);
		   return 0 unless (scalar keys %groups > 1);
		   my $is_active = ($widget{$keys[0]}->cget('-state') eq 'normal');
		   return 0 unless $is_active;
		   my $menu=$t->Menu(-tearoff=>0,
				     -menuitems=>[["command"=>"Set all groups to this value of $text",
						   -command => sub{&set_params('all', @keys)},
						   -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
						  ],
						  ["command"=>"Set marked groups to this value of $text",
						   -command => sub{&set_params('marked', @keys)},
						   -state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
						  ],
						  (($is_mee) ?
						   () :
						   (
						    "-",
						    ["command"=>"Set this value of $text to the standard",
						     -command => sub{&set_params('this', @keys)},
						     -state=>((scalar keys %groups > 2) and (not $groups{$current}->{frozen})) ? 'normal' : 'disabled',
						    ],
						    (($def_ok) ?
						     ("-",
						      ["command"=>"Make this value of $text the session default",
						       -command => sub{session_defaults(@keys)}],
						      "-",
						      ["command"=>"Set $text to its default for this group",
						       -state   => $groups{$current}->{frozen} ? 'disabled' : 'normal',
						       -command => sub{&set_params('def', @keys)},
						      ],
						     ) : ()),
						    ## additional items in the context menu
						    ((exists $extra{$text}) ?
						     ("-",
						      [ command          => "---- $text options ----",
							-foreground       =>'grey20',
							-activeforeground =>'grey20',
							-background       =>$config{colors}{background},
							-activebackground =>$config{colors}{background},
							-font	       =>$config{fonts}{smbold},],
						      @{ $extra{$text} })
						     : ()),
						   )),
						 ]);
		   $menu ->Popup(-popover=>'cursor', -popanchor=>'w');
		 });
  };
};



## this is bound to a keyboard shortcut, so I cannot rely on the
## checkbutton just above to maintain the state correctly
sub tie_untie_e0 {
  my $state = $groups{$current}->{bkg_tie_e0};
  $state = ($state+1) % 2;
  $groups{$current}->make(bkg_tie_e0    => $state,
			  bkg_former_e0 => ($state) ? $groups{$current}->{bkg_e0} : 0);
  $menus{bkg_tie_e0} = $state;
  my $message = ($menus{bkg_tie_e0}) ?
    "Energy and k values tied to e0." :
      "Energy and k values untied from e0.";
  Echo($message);
};

sub group_click {
  my ($t, $which) = @_;


  my @in     = (-background => $config{colors}{activebackground},
	        -cursor     => $mouse_over_cursor, );
  my @out    = (-background => $config{colors}{background});
  $t -> bind('<Any-Enter>'=>sub{$t -> configure(@in ); });
  $t -> bind('<Any-Leave>'=>sub{$t -> configure(@out); });

  my ($str, $desc) = ("", "");
 SWITCH: {
    ($which eq 'project') and do {
      $str = 'The name of the current project file.  Click the "modified" button to save this project.';
      $desc = 'PROJECT';
      last SWITCH;
    };
    ($which eq 'current') and do {
      $str = "These parameters set aspects of the central atom.";
      $desc = 'BACKGROUND';
      last SWITCH;
    };
    ($which eq 'bkg') and do {
      $str = "These parameters determine how the normalization and background spline are found.";
      $desc = 'BACKGROUND';
      last SWITCH;
    };
    ($which eq 'fft') and do {
      $str = "These parameters determine how the forward Fourier transform is performed.";
      $desc = "FORWARD TRANSFORM";
      last SWITCH;
    };
    ($which eq 'bft') and do {
      $str = "These parameters determine how the backward Fourier transform is performed.";
      $desc = "BACKWARD TRANSFORM";
      last SWITCH;
    };
    ($which eq 'plot') and do {
      $str = "These parameters set certain plotting features specific to this group.";
      $desc = "PLOTTING";
      last SWITCH;
    };
  };
  $t -> bind('<1>' => sub{Echo($str)});
  $t -> bind('<3>' =>
	     sub{my $t = shift;
		 return 0 if ($which eq 'current');
		 return 0 unless ($current);
		 return 0 unless (scalar keys %groups > 1);
		 my $is_frozen = $groups{$current}->{frozen};
		 ##my $blue = ($is_frozen) ? $config{colors}{frozen}               : $config{colors}{activehighlightcolor};
		 ##my $cyan = ($is_frozen) ? $config{colors}{frozenrequiresupdate} : $config{colors}{requiresupdate};
		 my $blue = $config{colors}{activehighlightcolor};
		 my $cyan = $config{colors}{requiresupdate};
		 my $is_active = (($t->cget('-foreground') eq $blue) or
				  ($t->cget('-foreground') eq $cyan));
		 return 0 unless $is_active;
		 my @keys = grep {/^$which/ and not /eshift/} (keys %widget);
		 ##print join(" ", @keys), $/;
		 my $menu;
		 if ($which eq 'project') {
		   $menu=$t->Menu(-tearoff=>0,
				  -menuitems=>[['command'=>"Set all groups'  values to the current",
						 -command=>sub{
						   Echo('No data!'), return unless ($current);
						   Echo("Parameters for all groups reset to \`$current\'");
						   my $orig = $current;
						   foreach my $x (keys %marked) {
						     next if ($x eq 'Default Parameters');
						     next if ($x eq $current);
						     next if ($groups{$x}->{frozen});
						     $groups{$x}->set_to_another($groups{$current});
						     set_properties(1, $x, 0);
						   };
						   set_properties(1, $orig, 0);
						   Echo(@done);}],
					       ['command'=>"Set all marked groups'  values to the current",
						 -command=>sub{
						   Echo('No data!'), return unless ($current);
						   Echo("Parameters for all marked groups reset to \`$current\'");
						   my $orig = $current;
						   foreach my $x (keys %marked) {
						     next if ($x eq 'Default Parameters');
						     next if ($x eq $current);
						     next if ($groups{$x}->{frozen});
						     next unless ($marked{$x});
						     $groups{$x}->set_to_another($groups{$current});
						     set_properties(1, $x, 0);
						   };
						   set_properties(1, $orig, 0);
						   Echo(@done);}],
					       ['command'=>"Set current groups'  values to their defaults",
						-state   => $is_frozen ? 'disabled' : 'normal',
						-command=>sub{
						   Echo('No data!'), return unless ($current);
						   my @keys = grep {/^(bft|bkg|fft)/} (keys %widget);
						   set_params('def', @keys);
						   set_properties(1, $current, 0);
						   Echo("Reset all values for this group to their defaults");}],
					      ]);
		 } else {
		   $menu=$t->Menu(-tearoff=>0,
				  -menuitems=>[["command"=>"Set all groups to these $desc parameters",
						-command => sub{&set_params('all', @keys)},
						-state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
					       ],
					       ["command"=>"Set marked groups to these $desc parameters",
						-command => sub{&set_params('marked', @keys)},
						-state=>(scalar keys %groups > 2) ? 'normal' : 'disabled',
					       ],
					       "-",
					       ["command"=>"Set these $desc parameters to the standard",
						-command => sub{&set_params('this', @keys)},
						-state=>((scalar keys %groups > 2) and (not $is_frozen)) ? 'normal' : 'disabled',
					       ],
					       "-",
					       ["command"=>"Set these $desc parameters to their defaults",
						-state   => $is_frozen ? 'disabled' : 'normal',
						-command => sub{&set_params('def', @keys)}],
					       ["command"=>"Make these $desc parameters the session defaults",
						-command => sub{session_defaults(@keys)}],
					       (($which eq 'bkg') ?
					       ("-",
						["command"=>"Document section: background removal",
						 -command =>sub{pod_display("bkg::index.pod")}])
					       : ()),
					      ]);
		 };
		 $menu ->Popup(-popover=>'cursor', -popanchor=>'w');
	       });
};


## This is the function invoked by the right mouse click of a
## parameter label.  It is used to set individual parameters in or
## from other groups.
##   all:    set this parameter in all groups to the current
##           group's value
##   marked: set this parameter in all marked groups
##   this:   set this parameter in this group to the value in the
##           marked group (requires that one and only one group be marked)
sub set_params {
  my $how = shift;
  my @keys = @_;
  ($keys[0] = 'bkg_z')    if ($keys[0] eq 'z');
  ($keys[0] = 'fft_edge') if ($keys[0] eq 'edge');
  my ($e0response, $eshiftresponse) = ("","");
  my $save = $groups{$current}->{bkg_tie_e0}; # temporarily turn off tie_e0
  $groups{$current}->make(bkg_tie_e0=>0);

 SP: {
    ($how eq 'this') and do {
      my ($n, $which) = (0, '');
      foreach my $g (keys %marked) {
	($marked{$g}) and ($which = $g) and ++$n;
      };
      if ($n != 1) {
	$groups{$current}->make(bkg_tie_e0=>$save);
	Error('A standard is defined by marking one and only one group.');
	return;
      };
      foreach my $k (@keys) {
	my $val = $groups{$which}->{$k};
	## take care not to make a group it's own bkg standard
	($k eq 'bkg_stan') and ($val eq $current) and next;
	($k eq 'bkg_alg') or $groups{$current} -> make($k => $val);
	($k = 'bkg_nnorm') if ($k =~ m{bkg_nnorm});
	if ($k eq 'bkg_alg') {
	  $val = $groups{$which}->{bkg_cl};
	  $groups{$current} -> make(bkg_cl=>$val);
	  $val and $groups{$current} -> make(bkg_z=>$groups{$which}->{bkg_z});
	  $menus{bkg_alg} = ($val) ? 'CLnorm' : 'Autobk';
	  if ($val) {
	    $menus{bkg_z} = $groups{$which}->{bkg_z};
	    #$widget{bkg_z} -> configure(-state=>'normal');
	    $widget{bkg_rbkg} -> configure(-state=>'disabled');
	    foreach my $s (qw(bkg_spl1 bkg_spl2 bkg_spl1e bkg_spl2e)) {
	      $widget{$s} -> configure(-state=>'disabled');
	      $grab{$s} -> configure(-state=>'disabled');
	    };
	  } else {
	    #$widget{bkg_z} -> configure(-state=>'disabled');
	    $widget{bkg_rbkg} -> configure(-state=>'normal');
	    foreach my $s (qw(bkg_spl1 bkg_spl2 bkg_spl1e bkg_spl2e)) {
	      $widget{$s} -> configure(-state=>'normal');
	      $grab{$s} -> configure(-state=>'normal');
	    };
	  };
	} elsif ($widget{$k} =~ /Entry/) {
	  $widget{$k} -> configure(-validate=>'none');
	  $widget{$k} -> delete(qw/0 end/);
	  $widget{$k} -> insert(0, $groups{$current}->{$k});
	  $widget{$k} -> configure(-validate=>'key');
	  set_variable($k, $val, 1);
	} elsif ($widget{$k} =~ /Optionmenu/) {
	  $menus{$k} = $groups{$current}->{$k};
	  ($k eq 'bkg_alg') and ($val eq 'CLnorm') and
	    $menus{bkg_z} = $groups{$current}->{bkg_z};
	} elsif ($k eq 'bkg_flatten') {
	  $groups{$current} -> make(bkg_flatten=>$groups{$which}->{bkg_flatten});
	  if ($groups{$current} -> {bkg_flatten}) {
	    $widget{bkg_flatten}->select;
	  } else {
	    $widget{bkg_flatten}->deselect;
	  };
	};			# flag for updates
	($k =~ /bkg/) and $groups{$current}->make(update_bkg=>1);
	($k =~ /fft/) and $groups{$current}->make(update_fft=>1);
	($k =~ /bft/) and $groups{$current}->make(update_bft=>1);
      };
      Echo("Set variable(s) to the standard.");
    }; ## end of "this" block

    ($how eq 'def') and do {
      foreach my $k (@keys) {
	($k = 'bkg_nnorm') if ($k =~ m{bkg_nnorm});
	if ($k eq 'importance') {
	  $groups{$current}->make(importance=>1);
	  set_properties(0,$current,0);
	  $groups{$current}->make(bkg_tie_e0=>$save);
	  return;
	};
	next if (($k =~ /^plot/) or ($k =~ /^(edge|z)$/) or
		 ($k =~ /^bkg_(alg|e0|eshift|fixstep|stan|step)/));
	my ($s,$key) = split(/_/, $k);
	my $val = $config{$s}{$key};
	#print join("|", $k, $s, $key, $val), $/;
	$groups{$current}->make($k=>$val);
	($k =~ /bkg/) and $groups{$current}->make(update_bkg=>1);
	($k =~ /fft/) and $groups{$current}->make(update_fft=>1);
	($k =~ /bft/) and $groups{$current}->make(update_bft=>1);
	## range parameters require special attention
	if ($k =~ /(bkg_(nor[12]|pre[12]|spl([12]|1e|2e))|fft_km(ax|in))/) {
	  my ($pre1, $pre2, $nor1, $nor2, $spl1, $spl2, $kmin, $kmax) =
	    set_range_params($current);
	  ($kmax = 12) if ($kmax <= 0);
	SWITCH: {
	    $groups{$current}->make(bkg_pre1 =>$pre1), last SWITCH if ($k eq 'bkg_pre1');
	    $groups{$current}->make(bkg_pre2 =>$pre2), last SWITCH if ($k eq 'bkg_pre2');
	    $groups{$current}->make(bkg_nor1 =>$nor1), last SWITCH if ($k eq 'bkg_nor1');
	    $groups{$current}->make(bkg_nor2 =>$nor2), last SWITCH if ($k eq 'bkg_nor2');
	    $groups{$current}->make(bkg_spl1 =>$spl1,
				    bkg_spl1e=>$groups{$current}->k2e($spl1)), last SWITCH if ($k eq 'bkg_spl1');
	    $groups{$current}->make(bkg_spl2 =>$spl2,
				    bkg_spl2e=>$groups{$current}->k2e($spl2)), last SWITCH if ($k eq 'bkg_spl2');
	    $groups{$current}->make(fft_kmin =>$kmin), last SWITCH if ($k eq 'fft_kmin');
	    $groups{$current}->make(fft_kmax =>$kmax), last SWITCH if ($k eq 'fft_kmax');
	    $groups{$current}->make(bkg_spl1 =>$spl1,
				    bkg_spl1e=>$groups{$current}->k2e($spl1)), last SWITCH if ($k eq 'bkg_spl1e');
	    $groups{$current}->make(bkg_spl2 =>$spl2,
				    bkg_spl2e=>$groups{$current}->k2e($spl2)), last SWITCH if ($k eq 'bkg_spl2e');
	    $groups{$current}->make(bkg_flatten =>$config{bkg}{flatten}),      last SWITCH if ($k eq 'bkg_flatten');
	  };
	  $groups{$current} -> kmax_suggest(\%plot_features) if ($groups{$current}->{fft_kmax} == 999);
	};
      };
      set_properties(0,$current,0);
      Echo("Set default variable value(s).");
    }; ## end of "def" block

    (($how eq 'all') or ($how eq 'marked')) and do {
      my ($inc_e0, $inc_eshift) = ("", "");
      if ($config{general}{query_constrain}) {
	my $dialog =
	  $top -> Dialog(-bitmap         => 'questhead',
			 -text           => "You are about to constrain parameters across $how groups.  Are you sure you want to do this?",
			 -title          => 'Athena: Constrain parameters...?',
			 -buttons        => [qw/Yes No/],
			 -default_button => 'Yes');
	my $response = $dialog->Show();
	return if ($response eq 'No');
	$e0response = $eshiftresponse = 'Yes';
      } else {
	$inc_e0     = grep(/bkg_e0/,     @keys);
	$inc_eshift = grep(/bkg_eshift/, @keys);
	if ($inc_e0 and $inc_eshift) {
	  my $dialog =
	    $top -> Dialog(-bitmap         => 'questhead',
			   -text           => "You are about to constrain both E0 and the E0 shift for $how groups.  Constraining E0 shifts can be a bad idea if there are groups of different edges and E0 shifts are typically set in the alignment dialog.  Should Athena constrain the E0 values?",
			   -title          => 'Athena: Constrain e0 and the e0 shift...?',
			   -buttons        => [qw/Yes No/],
			   -default_button => 'Yes');
	  $e0response = $dialog->Show();
	  $eshiftresponse = $e0response;
	};
      };
      foreach my $g (keys %marked) {
	next if ($g eq $current);
	next if (($how eq 'marked') and not $marked{$g});
	my $was = $groups{$g}->{bkg_tie_e0}; # temporarily turn off tie_e0
	$groups{$g}->make(bkg_tie_e0=>0);
      K: foreach my $k (@keys) {
	  ($k = 'bkg_nnorm') if ($k =~ m{bkg_nnorm});
	  if (($k eq 'bkg_e0') and not $inc_eshift) {
	    next K if ($e0response eq 'No');
	    unless ($e0response eq 'Yes') {
	      my $dialog =
		$top -> Dialog(-bitmap         => 'questhead',
			       -text           => "You are about to constrain E0 for $how groups.  This is handy if these groups are all of the same edge, but is a poor idea for groups of different edges.  Should Athena constrain the E0 values?",
			       -title          => 'Athena: Constrain e0...?',
			       -buttons        => [qw/Yes No/],
			       -default_button => 'Yes');
	      $e0response = $dialog->Show();
	      next K if ($e0response eq 'No');
	    };
	  } elsif (($k eq 'bkg_eshift') and not $inc_e0) {
	    next K if ($eshiftresponse eq 'No');
	    unless ($eshiftresponse eq 'Yes') {
	      my $dialog =
		$top -> Dialog(-bitmap         => 'questhead',
			       -text           => "You are about to constrain the E0 shift for $how groups.  Setting E0 shifts is normally done via the alignment dialog.  Should Athena constrain the E0 shift values?",
			       -title          => 'Athena: Constrain the e0 shift...?',
			       -buttons        => [qw/Yes No/],
			       -default_button => 'Yes');
	      $eshiftresponse = $dialog->Show();
	      next K if ($eshiftresponse eq 'No');
	    };
	  };
	  my $val = $groups{$current}->{$k};
	  ## take care not to make a group it's own bkg standard
	  ($k eq 'bkg_stan') and ($val eq $g) and next;
	  if ($k eq 'bkg_alg') {
	    $val = $groups{$current}->{bkg_cl};
	    $groups{$g} -> make(bkg_cl=>$val);
	    $val and $groups{$g} -> make(bkg_z=>$groups{$current}->{bkg_z});
	  } elsif ($k eq 'bkg_stan') {
	    $groups{$g} -> make(bkg_stan     => $val,
				#bkg_stan_lab => $groups,
			       );
	  } else {
	    $groups{$g} -> make($k => $val);
	  SWITCH: {
	      $groups{$g} -> make(bkg_spl1e => $groups{$g}->k2e($val)),
		last SWITCH if ($k eq 'bkg_spl1');
	      $groups{$g} -> make(bkg_spl2e => $groups{$g}->k2e($val)),
		last SWITCH if ($k eq 'bkg_spl2');
	      $groups{$g} -> make(bkg_spl1 => $groups{$g}->e2k($val)),
		last SWITCH if ($k eq 'bkg_spl1e');
	      $groups{$g} -> make(bkg_spl2 => $groups{$g}->e2k($val)),
		last SWITCH if ($k eq 'bkg_spl2e');
	    };
	  };			# flag for updates
	  ($k =~ /bkg/) and $groups{$g}->make(update_bkg=>1);
	  ($k =~ /fft/) and $groups{$g}->make(update_fft=>1);
	  ($k =~ /bft/) and $groups{$g}->make(update_bft=>1);
	};
	$groups{$g}->make(bkg_tie_e0=>$was);
      };
      Echo("Set variable(s) for all groups") if ($how eq 'all');
      Echo("Set variable(s) for all marked groups") if ($how eq 'marked');
    };  # end of "all" and "marked"

    (($how eq 'def_all') or ($how eq 'def_marked')) and do {
      Echo("Set this parameter to its default for all or marked groups....");
    };

    $groups{$current}->make(bkg_tie_e0=>$save);
  };
  project_state(0);
};


sub session_defaults {
  Echo("No data!"), return unless $current;
  foreach my $key (@_) {
    $groups{$current} -> SetDefault($key => $groups{$current}->{$key});
  };
};
sub clear_session_defaults {
## set default analysis parameter values
  $setup -> SetDefault(bkg_e0	   => $config{bkg}{e0},
		       bkg_kw	   => $config{bkg}{kw},
		       bkg_rbkg	   => $config{bkg}{rbkg},
		       bkg_pre1	   => $config{bkg}{pre1},
		       bkg_pre2	   => $config{bkg}{pre2},
		       bkg_nor1	   => $config{bkg}{nor1},
		       bkg_nor2	   => $config{bkg}{nor2},
		       bkg_nnorm   => $config{bkg}{nnorm},
		       bkg_spl1	   => $config{bkg}{spl1},
		       bkg_spl2	   => $config{bkg}{spl2},
		       bkg_nclamp  => $config{bkg}{nclamp},
		       bkg_clamp1  => $config{bkg}{clamp1},
		       bkg_clamp2  => $config{bkg}{clamp2},
		       bkg_flatten => $config{bkg}{flatten},
		       #fft_kw	   => $config{fft}{kw},
		       fft_dk	   => $config{fft}{dk},
		       fft_win	   => $config{fft}{win},
		       fft_kmin	   => $config{fft}{kmin},
		       fft_kmax	   => $config{fft}{kmax},
		       fft_pc	   => $config{fft}{pc},
		       bft_dr	   => $config{bft}{dr},
		       bft_win	   => $config{bft}{win},
		       bft_rmin	   => $config{bft}{rmin},
		       bft_rmax	   => $config{bft}{rmax},
		      );
};


## This is the callback used to validate entry boxes.  Mostly it makes
## sure that the entry is a number.  For the spline ranges, it
## recomputes the values in E or k as appropriate.  It also worries
## about relative and absolute energy values.
sub set_variable {
  ##print join(" | ", @_, $/);
  my ($k, $entry, $prop) = (shift, shift, shift);
  ## attempt to change background color on focus.  validate does not
  ## seem to work as advertised.
  #(defined($prop)) or $widget{$k} -> configure(-background=>'pink');
  return 0 if (($groups{$current}->{frozen}) and ($k !~ /^(ind|pf|po|sta|plot_yoffset)/));
  ($entry =~ m{\A\s*\z}) and ($entry = 0);	# error checking ...
  ($entry =~ m{\A\s*-\z}) and return 1;	# error checking ...
  ($entry =~ m{\A\s*-?(\d+\.?\d*|\.\d+)\s*\z}) or return 0;
  (($k =~ m{([bf]ft|spl[12]|rbkg)}) and ($entry < 0)) and return 0;
  (($k =~ m{\Atft_(?:d[kr]|[kr]m(?:ax|in)|npts|r[123])}) and ($entry < 0)) and return 0;
  (($k =~ m{lcf_noise}) and ($entry < 0)) and return 0;

  ## editing bkg_e0 and parameters are tied to the background
  ## need to keep track of previous reasonable value -- consider
  ## an edge energy of 11111.  Changing that to 11110 involves the
  ## sequence 11111 -> 1111 -> 11110.  For the middle step, all the
  ## other values will change by 10000 volts!  To avoid that, the
  ## former_e0 parameter is maintained and used to compute the shift
  ## of all the other parameters
  if (($k eq "bkg_e0") and ($groups{$current}->{bkg_tie_e0})) {
    my $save = $groups{$current}->{bkg_e0};
    my $delta = $entry - $groups{$current}->{bkg_former_e0};
    my $shift = sprintf("%.4f", (abs($delta) > 100) ? 0 : $delta);
    ##print join("\t", $entry, $groups{$current}->{bkg_e0}, $groups{$current}->{bkg_former_e0}, $delta, $shift), $/;
    $groups{$current}->make(bkg_former_e0 => (abs($delta) > 100)
			    ? $groups{$current}->{bkg_former_e0}
			    : $entry);
    foreach my $which (qw(pre1 pre2 nor1 nor2 spl1e spl2e)) {
      my $value = $groups{$current}->{"bkg_$which"}-$shift;
      ($value = 0) if (($value < 0) and ($which =~ m{spl}));
      $groups{$current} -> make("bkg_$which"  => $value);
      $widget{"bkg_$which"} -> configure(-validate=>'none');
      $widget{"bkg_$which"} -> delete(qw/0 end/);
      $widget{"bkg_$which"} -> insert(0, $groups{$current}->{"bkg_$which"});
      $widget{"bkg_$which"} -> configure(-validate=>'key');
    };
    ## now fix up all the k-valued parameters
    $groups{$current}->make(bkg_spl1=>$groups{$current}->e2k($groups{$current}->{bkg_spl1e}),
			    bkg_spl2=>$groups{$current}->e2k($groups{$current}->{bkg_spl2e}),
			   );
    foreach my $which (qw(fft_kmin fft_kmax)) {
      my $e = $groups{$current}->k2e($groups{$current}->{$which})-$shift;
      my $k = $groups{$current}->e2k($e);
      $groups{$current}->make($which=>$k);
    };
    foreach my $which (qw(bkg_spl1 bkg_spl2 fft_kmin fft_kmax)) {
      $widget{$which} -> configure(-validate=>'none');
      $widget{$which} -> delete(qw/0 end/);
      $widget{$which} -> insert(0, $groups{$current}->{$which});
      $widget{$which} -> configure(-validate=>'key');
    };
  };

  ## spline boundaries
  if ($k =~ /bkg_spl/) {
    my $x;
    if ($k eq 'bkg_spl1') {
      my $e = $groups{$current}->k2e($entry);
      $groups{$current}->make(bkg_spl1e=>$e);
      $x = 'bkg_spl1e';
    } elsif ($k eq 'bkg_spl2') {
      my $e = $groups{$current}->k2e($entry);
      $groups{$current}->make(bkg_spl2e=>$e);
      $x = 'bkg_spl2e';
    } elsif ($k eq 'bkg_spl1e') {
      my $k = $groups{$current}->e2k($entry);
      $groups{$current}->make(bkg_spl1=>$k);
      $x = 'bkg_spl1';
    } elsif ($k eq 'bkg_spl2e') {
      my $k = $groups{$current}->e2k($entry);
      $groups{$current}->make(bkg_spl2=>$k);
      $x = 'bkg_spl2';
    };
    $widget{$x} -> configure(-validate=>'none');
    $widget{$x} -> delete(qw/0 end/);
    $widget{$x} -> insert(0, $groups{$current}->{$x});
    $widget{$x} -> configure(-validate=>'key');
  };

  # handle limits of deglitching margins
  if ($k =~ /^deg/) {
    my ($abs_pre1, $abs_pre2, $abs_nor1, $abs_nor2) =
      ($groups{$current}->{bkg_e0} + $groups{$current}->{bkg_pre1},
       $groups{$current}->{bkg_e0} + $groups{$current}->{bkg_pre2},
       $groups{$current}->{bkg_e0} + $groups{$current}->{bkg_nor1},
       $groups{$current}->{bkg_e0} + $groups{$current}->{bkg_nor2});
    my $x;
    if ($k eq 'deg_emin') {
      if (($entry > $groups{$current}->{deg_emax}) and
	  ($entry < $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emax} < $groups{$current}->{bkg_e0})) {
	return 0
      } elsif (($entry < $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emax} > $abs_pre2)) {
	$groups{$current}->make(deg_emax=>$abs_pre2);
	$x = 'deg_emax';
      } elsif (($entry > $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emax} < $entry)) {
	$groups{$current}->make(deg_emax=>$abs_nor2);
	$x = 'deg_emax';
      };
    } elsif ($k eq 'deg_emax'){
      if (($entry < $groups{$current}->{deg_emin}) and
	  ($entry > $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emin} > $groups{$current}->{bkg_e0})) {
	return 0
      } elsif (($entry < $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emin} > $entry)) {
	$groups{$current}->make(deg_emin=>$abs_pre1);
	$x = 'deg_emin';
      } elsif (($entry > $groups{$current}->{bkg_e0}) and
	  ($groups{$current}->{deg_emin} < $abs_nor1)) {
	$groups{$current}->make(deg_emin=>$abs_nor1);
	$x = 'deg_emin';
      };
    };
    if ($x) {
      my $v = $groups{$current}->{$x};
      $widget{$x} -> configure(-validate=>'none');
      $widget{$x} -> delete(qw/0 end/);
      $widget{$x} -> insert(0, $v);
      $widget{$x} -> configure(-validate=>'key');
    };
  };

  ## linear combination fit parameters
  if ($k =~ /^lcf_fitm(ax|in)/) {
    $groups{$current}->make($k=>$entry);
    $widget{$k} -> configure(-validate=>'none');
    $widget{$k} -> delete(qw/0 end/);
    $widget{$k} -> insert(0, $groups{$current}->{$k});
    $widget{$k} -> configure(-validate=>'key');
    return 1;
  };

  $groups{$current}->make($k=>$entry), return 1 if ($k =~ m{^mee});

  ## return if this is not a front-page variable
  return 1 if ($k =~ /\A(?:al|lcf|tft)/);
  project_state(0), return 1 if ($k =~ /\A(?:conv|ind|pf|po|sa|sta)/);
  return 1 if ($k =~ /\A(?:enc|rebin)/);

  ## set this variable
  $groups{$current}->make($k=>$entry);
  if ($k eq 'bkg_e0') {
    my $k = $groups{$current}->{bkg_spl1};
    $groups{$current} -> make(bkg_spl1e=>$groups{$current}->k2e($k));
    $k = $groups{$current}->{bkg_spl2};
    $groups{$current} -> make(bkg_spl2e=>$groups{$current}->k2e($k));
    foreach my $x (qw/bkg_spl1e bkg_spl2e/) {
      $widget{$x} -> configure(-validate=>'none');
      $widget{$x} -> delete(qw/0 end/);
      $widget{$x} -> insert(0, $groups{$current}->{$x});
      $widget{$x} -> configure(-validate=>'key');
    };
  };

  ## tie together data and reference
  if ($k eq 'bkg_eshift') {
    if ($groups{$current}->{reference} and exists($groups{$groups{$current}->{reference}})) {
      $groups{$groups{$current}->{reference}} -> make(bkg_eshift=>$entry);
    };
  };

 SWITCH: {			# flag what chores need updating
    $groups{$current}->make(update_bkg=>1), last SWITCH if ($k =~ /bkg/);
    $groups{$current}->make(update_fft=>1), last SWITCH if ($k =~ /fft/);
    $groups{$current}->make(update_bft=>1), last SWITCH if ($k =~ /bft/);
  };

  project_state(0);
  return 1;
};

sub check_z {
  my $this = shift;
  return 1 if ($this =~ /$Ifeffit::Files::elem_regex$/i);
  my $dialog =
    $top -> Dialog(-bitmap         => 'error',
		   -text           => "$menus{bkg_z} is not an element symbol",
		   -title          => 'Athena: Invalid element symbol',
		   -buttons        => ['OK'],
		   -default_button => 'OK',
		   -popover        => 'cursor');
  $dialog->raise;
  my $response = $dialog->Show();
  $widget{z} -> focus;
  return 0;
};

sub identify_reference {
  my $message = "This group does not have a reference channel.";
  if (exists($groups{$groups{$current}->{reference}})) {
    my $this = $groups{$current}->{label};
    my $ref  = $groups{$groups{$current}->{reference}}->{label};
    $message = "The reference for \"$this\" is \"$ref\".";
  };
  Echo($message);
};

sub explain_eshift {
  my $text = <<EOH
The energy shift is applied to the energy axis of the input data before any other data processing
happens.  Thus the value for E0 is chosen on the data's energy axis AFTER the energy shift is applied.

Other energy values, such as the pre- and post-edge line parameters and the plotting range
take relative energy values.  Their values are relative to E0, thus computed AFTER the energy
shift is applied.

Data processing operations such as merging and calculation of difference spectra are also
performed AFTER the energy shift is applied.  The energy shift can be changed by hand, but is
normally set using the data alignment dialog.
EOH
    ;
  $text =~ s{\n}{ }g;
  $text =~ s/ /\n\n/g;
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => $text,
		   -title          => 'Athena: Understanding the energy shift',
		   -buttons        => ['OK'],
		   -default_button => 'OK',
		   #-popover        => 'cursor',
		  );
  $dialog->raise;
  my $response = $dialog->Show();
  return 0;
};

## END OF DRAW PROPERTIES SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2008 Bruce Ravel
##
##  This section of the code contains the subroutine for setting
##  properties for display of a newly selected group

sub set_properties {
  my $how = shift;
  my $item = shift;
  my $saving = shift;
  my @normal   = (-fill   =>$config{colors}{background},
		  -outline=>$config{colors}{background});
  my @selected = (-fill   =>$config{colors}{current},
		  -outline=>$config{colors}{current});

  ## fixed step may not be up to date if the fixstep button was
  ## pressed, then the step size was edited
  $groups{$current} -> make(bkg_step => $widget{bkg_step}->cget('-value')) if $groups{$current}->{bkg_fixstep};

  #return if (($fat_showing eq 'normal') and ($item eq $current));

  ## a regex to match %grab buttons *not* on the main page
  my $grabskip = join("|", qw(deg lr peak etrun sta));
  my ($blue, $cyan, $grey, $black, $h_font) = ($config{colors}{activehighlightcolor},
					       $config{colors}{requiresupdate},
					       $config{colors}{disabledforeground},
					       $config{colors}{foreground},
					       $config{fonts}{bold});
  my $textcolor = $config{colors}{foreground};

  ## place a mark in the skinny window indicating which group is current
  my ($check, $widg, $rect, $prev);
  if ($current) {
    $rect = $groups{$current}->{rect};
    $list -> itemconfigure($rect, @normal);
    update_hook($current);
  };
  $prev = $current;
  $current = $item;
  if ($groups{$current}->{frozen}) {
    #($blue, $cyan) = ($config{colors}{frozen}, $config{colors}{frozenrequiresupdate});
    #$textcolor = $config{colors}{frozen};
    $h_font = $config{fonts}{boldit};
    @selected = (-fill   =>$config{colors}{frozencurrent},
		 -outline=>$config{colors}{frozencurrent});
  };
  $rect = $groups{$current}->{rect};
  $list -> itemconfigure($rect, @selected);
  ## restore normal text size/color to this label
  $list -> itemconfigure($groups{$current}->{text},
			 -fill => $textcolor,
			 -font => ($groups{$current}->{frozen}) ? $config{fonts}{medit} : $config{fonts}{med});

  ($how == 1) or Echonow("displaying parameters for group \"$groups{$item}->{label}\"");

  ## only want to do a Busy if something else isn't already doing so
  ## because we do not want to release the grab at the end of this
  ## routine should something else need to continue the grab after
  ## this is finished
  my $is_busy = grep (/Busy/, $top->bindtags);
  #print join(" ", "before", $top->bindtags), $/;
  $top -> Busy unless $is_busy;
  #print join(" ", "after", $top->bindtags), $/;

  ## these two widgets should be uneditable but selectable

  $widget{current} -> configure(qw/-state normal/);
  $widget{current} -> delete(qw/0 end/);
  if ($use_default) {
    $widget{current} -> insert(0, $groups{$item}->{label});
  } else {
    if ($item eq "Default Parameters") {
      $widget{current} -> insert(0, "<no files loaded>");
      project_state(1);
    } else {
      $widget{current} -> insert(0, $groups{$item}->{label});
    };
  };
  $widget{current} -> configure(qw/-state disabled/);

  $widget{group} -> configure(qw/-state normal/);
  $widget{group} -> delete(qw/0 end/);
  if ($use_default) {
    $widget{group} -> insert(0, $groups{$item}->{label});
  } else {
    $widget{group} -> insert(0, ($item eq "Default Parameters") ? "" :
			       $groups{$item}->{group});
  };
  $widget{group} -> configure(qw/-state disabled/);


  $widget{file} -> configure(qw/-state normal/);
  $widget{file} -> delete(qw/0 end/);
  $widget{file} -> insert(0, $groups{$item}->{file});
  $widget{file} -> xview('end');
  $widget{file} -> configure(qw/-state disabled/);

  $widget{z} -> configure(-state=>($item eq "Default Parameters") ?
			  'disabled' : 'normal');
  $widget{edge} -> configure(-state=>($item eq "Default Parameters") ?
			  'disabled' : 'normal');

  #$widget{bkg_eshift} -> configure(-text=>$groups{$current}->{bkg_eshift});
  #$widget{bkg_step}   -> configure(-text=>sprintf "%.2f", $groups{$current}->{bkg_step});

  $header{project} -> configure(-foreground=>$blue, -font=>$h_font);
  $header{current} -> configure(-foreground=>$blue, -font=>$h_font,
				-text=>$groups{$current}->{frozen} ? "  Frozen group" : "  Current group");
  $header{plot}    -> configure(-foreground=>$blue, -font=>$h_font);
  if ($item eq "Default Parameters") {
    map {$header{$_} -> configure(-foreground=>$blue, -font=>$h_font)} qw(bkg fft bft);
  };

  ## enable/disable red plotting buttons
  map {$b_red{$_} -> configure(-state=>'normal')} (keys %b_red);
  ## enable/disable "save as" menu options
  ## -1=chi rec, +1=mu, +2=norm, +3=chi(k), +4=chi(R), +5=chi(q)
  my $sep = ($Tk::VERSION > 804) ? 7 : 8;
  map {$file_menu -> menu -> entryconfigure($_, -state=>'normal')} ($sep+1 .. $sep+5);
  $data_menu -> menu -> entryconfigure(9, -state=>'disabled'); # Self Absorption
  ##$freeze_menu -> menu -> entryconfigure(1, -label=>$groups{$item}->{frozen} ? 'Unfreeze this group': 'Freeze this group');
  ## also enable/disable headers according to data type
 SWITCH:{
    ($groups{$item}->{is_xanes}) and do {
      $header{bkg} -> configure(-foreground=>($groups{$item}->{update_bkg}) ? $cyan : $blue, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>($groups{$item}->{update_bkg}) ? $cyan : $blue, -font=>$h_font);
      $header{fft} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bft} -> configure(-foreground=>$grey, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
      map {$grab{"bkg_$_"} -> configure(-state=>'normal')} (qw(pre1 pre2 nor1 nor2 e0));
      map {$b_red{$_} -> configure(-state=>'disabled')} (qw(k R q kq));
      map {$file_menu -> menu -> entryconfigure($_, -state=>'disabled')} ($sep+3 .. $sep+4);
      $data_menu -> menu -> entryconfigure(9, -state=>'normal'); # Self Absorption
      last SWITCH;
    };
    ($groups{$item}->{is_xmu}) and do {
      $header{bkg} -> configure(-foreground=>($groups{$item}->{update_bkg}) ? $cyan : $blue, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>($groups{$item}->{update_bkg}) ? $cyan : $blue, -font=>$h_font);
      $header{fft} -> configure(-foreground=>($groups{$item}->{update_fft}) ? $cyan : $blue, -font=>$h_font);
      $header{bft} -> configure(-foreground=>($groups{$item}->{update_bft}) ? $cyan : $blue, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'normal')} (keys %grab);
      $data_menu -> menu -> entryconfigure(9, -state=>'normal'); # Self Absorption
      last SWITCH;
    };
    ($groups{$item}->{is_chi}) and do {
      $header{bkg} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{fft} -> configure(-foreground=>($groups{$item}->{update_fft}) ? $cyan : $blue, -font=>$h_font);
      $header{bft} -> configure(-foreground=>($groups{$item}->{update_bft}) ? $cyan : $blue, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
      map {$grab{$_} -> configure(-state=>'normal')} (qw/fft_kmin fft_kmax bft_rmin bft_rmax/);
      map {$b_red{$_} -> configure(-state=>'disabled')} (qw(E));
      map {$file_menu -> menu -> entryconfigure($_, -state=>'disabled')} ($sep+1 .. $sep+2);
      $data_menu -> menu -> entryconfigure(9, -state=>'normal'); # Self Absorption
      last SWITCH;
    };
    ($groups{$item}->{is_rsp}) and do {
      $header{bkg} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{fft} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bft} -> configure(-foreground=>($groups{$item}->{update_bft}) ? $cyan : $blue, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
      map {$grab{$_} -> configure(-state=>'normal')} (qw/bft_rmin bft_rmax/);
      map {$b_red{$_} -> configure(-state=>'disabled')} (qw(E k kq));
      map {$file_menu -> menu -> entryconfigure($_, -state=>'disabled')} ($sep+1 .. $sep+3);
      last SWITCH;
    };
    ($groups{$item}->{is_qsp}) and do {
      $header{bkg} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{fft} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bft} -> configure(-foreground=>$grey, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
      map {$b_red{$_} -> configure(-state=>'disabled')} (qw(E k R kq));
      map {$file_menu -> menu -> entryconfigure($_, -state=>'disabled')} ($sep+1 .. $sep+4);
      last SWITCH;
    };
    ($groups{$item}->{not_data}) and do {
      $header{bkg} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bkg_secondary} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{fft} -> configure(-foreground=>$grey, -font=>$h_font);
      $header{bft} -> configure(-foreground=>$grey, -font=>$h_font);
      map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
      map {$b_red{$_} -> configure(-state=>'disabled')} (qw(k R q kq));
      map {$file_menu -> menu -> entryconfigure($_, -state=>'disabled')} ($sep+2 .. $sep+5);
      last SWITCH;
    };
  };
  if (not $groups{$item}->{is_xmu}) {
    $widget{"bkg_$_"} -> configure(-state=>'disabled')
      foreach (qw(alg fixstep flatten fnorm nnorm1 nnorm2 nnorm3));
  } else {
    $widget{"bkg_$_"} -> configure(-state=>'normal')
      foreach (qw(fixstep flatten fnorm nnorm1 nnorm2 nnorm3));
    $widget{bkg_step} -> configure(-foreground => $config{colors}{foreground});
  };
  $widget{fft_pc} -> configure(-state=>'normal');



  foreach my $x ($groups{$item} -> Keys) {
    next if (($x eq "file") or ($x eq "line"));
    next if ($x eq "fft_edge");
    next if (($x eq "bkg_z") or ($x eq "fft_edge"));
    next if ($x eq "bkg_nclamp");
    next if ($x eq "bkg_fitted_step");
    next if ($x eq "bkg_stan_lab");

    ## treat BrowsEntry widgets specially
    my $normal = (ref($widget{$x}) =~ m{BrowseEntry}) ? 'readonly' : 'normal';

    if ($x eq "bkg_cl") {
      if ($groups{$item}->{is_diff}) {
	$widget{bkg_alg} -> configure(-state=>'disabled');
	#$widget{z}   -> configure(-state=>'disabled');
      } elsif ($groups{$item}->{is_xmu}) {
	$widget{bkg_alg} -> configure(-state=>$normal);
	$menus{bkg_alg} = ($groups{$item}->{bkg_cl}) ? 'CLnorm' : 'Autobk';
	#$widget{z} ->
	#  configure(-state => ($menus{bkg_alg} eq 'CLnorm') ? $normal : 'disabled');
      } else {
	$widget{bkg_alg} -> configure(-state=>'disabled');
      };
#     } elsif ($x eq "bkg_z") {
#       $widget{z} -> configure(-validate=>'none');
#       $menus{bkg_z} = $groups{$item}->{bkg_z};
#       $widget{z} -> configure(-validate=>'focusout');
    } else {
      #($x eq 'bkg_step') and print "bkg_step\n";
      $widget{$x} -> configure(-state=>$normal);
      if ($widget{$x} =~ /Entry/) {
	$widget{$x} -> configure(-validate=>'none');
	$widget{$x} -> delete(qw/0 end/);
	$widget{$x} -> insert(0, $groups{$item}->{$x});
	$widget{$x} -> configure(-validate=>'key');
      } elsif ($widget{$x} =~ /Optionmenu/) {
	$menus{$x} = $groups{$item}->{$x};
      } elsif ($widget{$x} =~ /Check/) {
	$menus{$x} = $groups{$item}->{$x};
      };
    };
    next unless (Exists($widget{$x}));
    $widget{$x} -> configure(-state=>$normal), next if ($x =~ /^plot/);
    ## disable widgets in the fields according to data type
  SWITCH: {
      ($groups{$item}->{is_xanes}) and do {
	if (($x =~ /^bkg/) or ($x eq "importance")) {
	  $widget{$x} -> configure(-state=>$normal);
	  $widget{$x} -> configure(-foreground=>$black);
	} else {
	  $widget{$x} -> configure(-state=>'disable');
	  $widget{$x} -> configure(-foreground=>$grey);
	};
	$widget{$x} -> configure(-state=>'disable')
	  if ($x =~ /(clamp[12]|kw|rbkg|spl[12]e?|stan)/);
	last SWITCH;
      };
      ($groups{$item}->{is_xmu}) and do {
	$widget{$x} -> configure(-state=>$normal);
	if ($groups{$item}->{bkg_cl}) {
	  if ($x =~ /^bkg_spl/) {
	    $widget{$x} -> configure(-state=>'disabled');
	    $grab{$x} -> configure(-state=>'disabled');
	  };
	};
	$widget{$x} -> configure(-foreground=>$black) unless (ref($widget{$x}) =~ /NumEntry/);
	if ($groups{$item}->{is_nor}) {
	  if ($x =~ /bkg_(pre[12]|nor[12])/) {
	    $widget{$x} -> configure(-state=>'disabled', -foreground=>$grey);
	    $grab{$x} -> configure(-state=>'disabled');
	  };
	  #if ($x =~ /bkg_f(ixstep|latten)/) {
	  if ($x =~ /bkg_fixstep/) {
	    $widget{$x} -> configure(-state=>'disabled', -foreground=>$grey);
	  };
	};
	last SWITCH;
      };
      ($groups{$item}->{is_chi}) and do {
	if ($x =~ /^bkg/) {
	  $widget{$x} -> configure(-state=>'disabled');
	  $widget{$x} -> configure(-foreground=>$grey);
	} else {
	  $widget{$x} -> configure(-state=>$normal);
	  $widget{$x} -> configure(-foreground=>$black);
	};
	last SWITCH;
      };
      ($groups{$item}->{is_rsp}) and do {
	if ($x =~ /^(bkg|fft)/) {
	  $widget{$x} -> configure(-state=>'disabled');
	  $widget{$x} -> configure(-foreground=>$grey);
	} else {
	  $widget{$x} -> configure(-state=>$normal);
	  $widget{$x} -> configure(-foreground=>$black);
	};
	last SWITCH;
      };
      ($groups{$item}->{is_qsp}) and do {
	$widget{$x} -> configure(-state=>'disabled');
	$widget{$x} -> configure(-foreground=>$grey);
	last SWITCH;
      };
      ($groups{$item}->{not_data}) and do {
	$widget{$x} -> configure(-state=>'disabled');
	$widget{$x} -> configure(-foreground=>$grey);
	last SWITCH;
      };
    };
  };

  if ($groups{$item}->{frozen}) {
    $widget{"bkg_$_"} -> configure(-state=>'disabled')
      foreach (qw(fixstep flatten fnorm nnorm1 nnorm2 nnorm3 step stan));
    $widget{fft_pc} -> configure(-state=>'disabled');
    map {($_ =~ /^($grabskip)/) or $grab{$_} -> configure(-state=>'disabled')} (keys %grab);
  };
  map {$values_menubutton -> menu -> entryconfigure($_, -state=>$groups{$item}->{frozen} ? 'disabled' : 'normal')}
    (3, 10);


  ## set various buttons
  foreach (qw(fixstep flatten fnorm nnorm tie_e0)) {
    $menus{"bkg_$_"} = $groups{$item}->{"bkg_$_"};
  };
  ## disable these until it's all working
  $widget{"bkg_fnorm"} -> configure(-state=>'disabled');


  ## mark eshift if this is a reference or a group with a reference
  my ($red, $bold, $normal) = ($config{colors}{button}, $config{fonts}{entrybold}, $config{fonts}{entry});
  if ($groups{$item}->{reference}) {
    $widget{bkg_eshift} -> configure(-foreground => $red,
				     -font       => $bold,)
  } else {
    $widget{bkg_eshift} -> configure(-foreground => $black,
				     -font       => $normal,)
  };

  ## set up the Standard optionmenu -- the list may have changed recently...
  ## (commented out stuff is from Optionmenu, tidy up when stable)
  if (($groups{$item}->{bkg_stan} ne 'None')
      and (exists $groups{$groups{$item}->{bkg_stan}})) {
    ##    $menus{bkg_stan} = $groups{$groups{$item}->{bkg_stan}}->{label};
    $groups{$groups{$item}->{bkg_stan}}->dispatch_bkg($dmode) if
      $groups{$groups{$item}->{bkg_stan}}->{update_bkg};
  } else {
    $menus{bkg_stan} = 'None';
    $menus{bkg_stan_lab} = '0: None';
    $groups{$item}->make(bkg_stan=>'None',
			 bkg_stan_lab=>'0: None');
  };

  $widget{bkg_stan} -> delete(0, 'end');
  $widget{bkg_stan} -> insert("end", "0: None");
  my @list = ('None');
  my $i = 1;
  foreach my $x (&sorted_group_list) {
    next if ($x eq $current);
    next unless (($groups{$x}->{is_xmu}) or ($groups{$x}->{is_chi}));
    push @list, $x;
    $widget{bkg_stan} -> insert("end", "$i: $groups{$x}->{label}");
    my $label = $groups{$groups{$item}->{bkg_stan}}->{label};
    if ($groups{$item}->{bkg_stan} eq $x) {
      $menus{bkg_stan_lab} = "$i: $label";
      $groups{$item} -> make(bkg_stan_lab => "$i: $label");
    };
    ++$i;
  };
  $menus{keys} = [@list];

  ## is this group a merge?
  $plot_menu -> menu -> entryconfigure(5, -state=>($groups{$item}->{is_merge}) ? 'normal' : 'disabled');
  $plot_menu -> menu -> entryconfigure(6, -state=>($groups{$item}->{i0}) ? 'normal' : 'disabled');
  $plot_menu -> menu -> entryconfigure(7, -state=>($groups{$item}->{i0}) ? 'normal' : 'disabled');
  ## can chi(E) be plotted?
  my $ok = ($groups{$item}->{is_xmu} or $groups{$item}->{is_nor} or
    $groups{$item}->{is_chi});
  #$plot_menu -> menu -> entryconfigure(9, -state=> $ok ? 'normal' : 'disabled');
  #$plot_menu -> menu -> entryconfigure(10, -state=> 'normal');
  ## is this an xmu group?  If so enable thingies to make detector
  ## groups and background group
  $ok = ($groups{$item}->{is_xmu} and $groups{$item}->{denominator}
	and (not $groups{$item}->{is_proj}));
  my $ind = 5; #($group_menubutton -> children())[0] -> index('detector');
  $group_menubutton -> menu ->
    entryconfigure($ind, -state=> $ok ? 'normal' : 'disabled');
  $group_menubutton -> menu ->
    entryconfigure($ind+1, -state=> $groups{$item}->{is_xmu} ? 'normal' : 'disabled');

  my $is_energy = not ($groups{$item}->{is_chi} or $groups{$item}->{is_rsp} or $groups{$item}->{is_qsp});
  $group_menubutton -> menu ->
    entryconfigure(8, -state=> $is_energy ? 'normal' : 'disabled');

  ## phase correction parameters (a checkbutton and two menus)
  $menus{bkg_z}     =  $groups{$item}->{bkg_z};
  $menus{fft_pc}    =  $groups{$item}->{fft_pc};
  $menus{fft_edge}  =  $groups{$item}->{fft_edge};
  #$widget{z}    -> configure(-state=>($menus{fft_pc} eq 'on') ? 'normal' : 'disabled');
  #$widget{edge} -> configure(-state=>($menus{fft_pc} eq 'on') ? 'normal' : 'disabled');

  ## deal with various parameters if something other than the normal
  ## display is present
 FAT: {
    ($saving) and do {
      1;			# do nothing more
      last FAT;
    };

    ($fat_showing eq 'peakfit') and do {
      $widget{peak_group} -> configure(-text=>$groups{$item}->{label});
      $widget{peak_save}  -> configure(-state=>'disabled');
      $widget{peak_log}   -> configure(-state=>'disabled');
      ## need to worry about non-xmu groups being selected
      unless ($groups{$item}->{is_xmu}) {
	if ($groups{$item}->{not_data}) {
	  $groups{$item}->plotE('em', $dmode, \%plot_features, \@indicator);
	} else {
	  Error("$groups{$item}->{label} cannot be plotted in energy.");
	};
	last FAT
      };
      my $r_peaks = $$hash_pointer{peaks};
      $groups{$item}->{update_bkg} and $groups{$item}->dispatch_bkg($dmode);
      $groups{$item}->{peak} and peak_fill_variables($item, $hash_pointer, $r_peaks);
      $groups{$item}->plotE('emn', $dmode, \%plot_features, \@indicator);
      my ($emin, $emax) = ($$hash_pointer{enot}+$$hash_pointer{emin},
			   $$hash_pointer{enot}+$$hash_pointer{emax});
      $groups{$item}->plot_vertical_line($emin, 0, $$hash_pointer{ymax},
					 $dmode, "fit range", $groups{$item}->{plot_yoffset});
      $groups{$item}->plot_vertical_line($emax, 0, $$hash_pointer{ymax},
					 $dmode, "", $groups{$item}->{plot_yoffset});
      $last_plot='e';
      last FAT;
    };

    ($fat_showing eq 'lograt') and do {
      $widget{lr_unknown} -> configure(-text=>$groups{$item}->{label});
      ## it is possible that the groups list has changed of late, so update
      ## the lists of standards
      my @keys = ();
      foreach my $k (&sorted_group_list) {
	($groups{$k}->{is_xmu} or $groups{$k}->{is_chi}) and push @keys, $k;
      };
      $widget{lr_menu} -> delete(0, 'end');
      my $i = 1;
      foreach my $s (@keys) {
	$widget{lr_menu} -> insert("end", "$i: $groups{$s}->{label}");
	++$i;
      };


      ## need to worry about non-xmu/chi groups being selected
      &reset_lr_data($hash_pointer, $$hash_pointer{standard}, $current)
	if ($groups{$current}->{is_xmu} or $groups{$current}->{is_chi});
      last FAT;
    };

    ($fat_showing eq 'calibrate') and do {
      $widget{cal_group} -> configure(-text=>$groups{$item}->{label});
      ## need to worry about non-xmu groups being selected
      $groups{$current} -> dispose("set $current.deriv = deriv($current.xmu)/deriv($current.energy)\n", $dmode);
      ($groups{$current}->{bkg_z}, $groups{$current}->{fft_edge})
	= find_edge($groups{$current}->{bkg_e0});
      $$hash_pointer{cal_to} = Xray::Absorption->get_energy($groups{$current}->{bkg_z},
							    $groups{$current}->{fft_edge});
      $$hash_pointer{e0} = $groups{$current}->{bkg_e0};
      ## plot this group
      $plot_features{suppress_markers} = 1;
      $groups{$current}->plotE($$hash_pointer{str}, $dmode, \%plot_features, \@indicator);
      $plot_features{suppress_markers} = 0;
      &cal_marker($current, $$hash_pointer{e0}, $$hash_pointer{str});
      last FAT;
    };

    ($fat_showing eq 'align') and do {
      ## need check for non-xmu data and for (standard->{ref} eq current)
      $widget{align_unknown} -> configure(-text=>$groups{$item}->{label});
      ##$widget{align_other_label} -> configure(-text=>"Shift \"$groups{$current}->{label}\" by ");
      $widget{align_other_label} -> configure(-text=>"Shift by ");
      $widget{align_result} -> delete(qw(0 end));
      $widget{align_result} -> insert('end', $groups{$current}->{bkg_eshift});
      $$hash_pointer{shift} = $groups{$current}->{bkg_eshift};
      $$hash_pointer{prior_shift} = $groups{$current}->{bkg_eshift};

      ## it is possible that the groups list has changed of late, so update
      ## the lists of standards
      my @keys = ();
      foreach my $k (&sorted_group_list) {
	$groups{$k}->{is_xmu} and push @keys, $k;
      };
      $widget{align_menu} -> delete(0, 'end');
      my $i = 1;
      foreach my $s (@keys) {
	$widget{align_menu} -> insert("end", "$i: $groups{$s}->{label}");
	++$i;
      };

      &do_eshift($hash_pointer, $current);
      last FAT;
    };

    ($fat_showing eq 'pixel') and do {
      $widget{pixel_unknown} -> configure(-text=>$groups{$item}->{label});
      if ($groups{$item}->{is_pixel}) {
	map {$widget{"pixel_".$_}->configure(-state=>'normal')}
	  (qw(refine replot make offset constrain linear linear_button quad));
      } else {
	map {$widget{"pixel_".$_}->configure(-state=>'disabled')}
	  (qw(refine replot make offset constrain linear linear_button quad));
      };
      ## $widget{pixel_make} -> configure(-state=>'disabled');
      &pixel_setup($hash_pointer) if $groups{$item}->{is_pixel};
      last FAT;
    };

    ($fat_showing eq 'truncate') and do {
      $widget{trun_group} -> configure(-text=>$groups{$item}->{label});
      $groups{$item} -> make(etruncate=>$widget{etruncate}->get());
      ## need to worry about non-xmu groups being selected
      $groups{$item} -> plotE('em',$dmode,\%plot_features, \@indicator);
      $last_plot = 'e';
      my $e = $groups{$item}->{etruncate};
      $groups{$item} -> dispose("set(___f = floor($item.xmu), ___c = ceil($item.xmu))\n", 1);
      my $ymin = Ifeffit::get_scalar("___f");
      my $ymax = Ifeffit::get_scalar("___c");
      $groups{$item} -> plot_vertical_line($e, $ymin, $ymax, $dmode,
					       "truncate", $groups{$item}->{plot_yoffset});
      last FAT;
    };

    ($fat_showing eq 'rebin') and do {
      $widget{rb_group} -> configure(-text=>$groups{$item}->{label});
      $$hash_pointer{abs}  = $groups{$item}->{bkg_z};
      $$hash_pointer{edge} = $groups{$item}->{bkg_e0};
      $widget{rb_plot}->configure(-state=>($groups{$item}->{is_xmu}) ? 'normal' : 'disabled');
      $widget{rb_save}->configure(-state=>'disabled');
      $groups{$item} -> plotE('em',$dmode,\%plot_features, \@indicator);
      last FAT;
    };

    ($fat_showing eq 'smooth') and do {
      $widget{sm_group} -> configure(-text=>$groups{$item}->{label});
      $groups{$item}->dispose("erase $item.smoothed", $dmode);
      $widget{sm_save}->configure(-state=>'disabled');
      $groups{$item} -> plotE('em',$dmode,\%plot_features, \@indicator);
      last FAT;
    };

    ($fat_showing eq 'convolve') and do {
      $$hash_pointer{current} = $groups{$current}->{label};
      $widget{conv_group}->configure(-state=>'disabled');
      $groups{$item}->plotE('emn', $dmode, \%plot_features, \@indicator);
      last FAT;
    };

    ($fat_showing eq 'diff') and do {
      $widget{diff_unknown} -> configure(-text=>$groups{$item}->{label});
      ## need to worry about selected group not being plottable in the
      ## difference space
      Error("Difference plot aborted: You cannot select the same data group twice!"),
	return if ($$hash_pointer{standard} eq $current);
      $$hash_pointer{integral} = "";
      my $dfg = $config{colors}{disabledforeground};
      $$hash_pointer{diff_integral_label} -> configure(-foreground=>$dfg);
      my $state = 'normal';
      my @keys = ();
      my @allkeys = (&sorted_group_list);
    SWITCH: {
	($groups{$item}->{is_diff}) and do {
	  $state = 'disabled';
	  last SWITCH;
	};
	($$hash_pointer{space} =~ /[en]/) and do {
	  ($state = 'disabled') unless $groups{$item}->{is_xmu};
	  foreach my $k (@allkeys) {
	    ($groups{$k}->{is_xmu}) and push @keys, $k;
	  };
	  last SWITCH;
	};
	($$hash_pointer{space} eq 'k') and do {
	  ($state = 'disabled') unless ($groups{$item}->{is_xmu} or $groups{$item}->{is_chi});
	  foreach my $k (@allkeys) {
	    ($groups{$k}->{is_xmu} or $groups{$k}->{is_chi}) and push @keys, $k;
	  };
	  last SWITCH;
	};
	($$hash_pointer{space} eq 'r') and do {
	  foreach my $k (@allkeys) {
	    ($groups{$k}->{is_qsp}) or push @keys, $k;
	  };
	  ($state = 'disabled') if $groups{$item}->{is_qsp};
	  last SWITCH;
	};
	($$hash_pointer{space} eq 'q') and do {
	  foreach my $k (@allkeys) {
	    ($groups{$k}->{not_data}) or push @keys, $k;
	  };
	  last SWITCH;
	};
      };
      map { $widget{'diff_'.$_} -> configure(-state=>$state) }
	(qw(savemarkedi savemarked save replot xmin xmax));
      map { $grab{'diff_'.$_} -> configure(-state=>$state) }
	(qw(xmin xmax));

      ## it is possible that the groups list has changed of late, so update
      ## the lists of standards
      $widget{diff_menu} -> delete(0, 'end');
      my $i = 1;
      foreach my $s (@keys) {
	$widget{diff_menu} -> insert("end", "$i: $groups{$s}->{label}");
	++$i;
      };

      if ($state eq 'normal') {
	my $ok = $groups{$$hash_pointer{standard}} ->
	  plot_difference($groups{$current}, $hash_pointer, $dmode, \%plot_features);
	$last_plot=$$hash_pointer{space} if $ok;
      };
      last FAT;
    };

    ($fat_showing eq 'deglitch') and do {
      $widget{deg_group} -> configure(-text=>$groups{$item}->{label});
      ## worry about non-xmu groups
      $$hash_pointer{standard} = $current;
      set_deglitch_params($hash_pointer);
      if ($$hash_pointer{space} eq 'emg') {
	$groups{$current} -> plotE('emg',$dmode,\%plot_features, \@indicator);
      } else {
	&plot_chie($current);
      };
      $last_plot = 'e';
      last FAT;
    };

    ($fat_showing eq 'lcf') and do {
      $widget{lcf_unknown} -> configure(-text=>$groups{$item}->{label});
      $widget{lcf_operations} -> entryconfigure(4, -state=>'disabled', -style=>$$hash_pointer{disabled_style});
      $widget{lcf_operations} -> entryconfigure(8, -state=>'disabled', -style=>$$hash_pointer{disabled_style});
      if ($groups{$item}->{is_chi} and ($$hash_pointer{fitspace} ne 'k')) {
	$groups{$item}->MAKE("lcf_fitspace" => 'k');
      };
      if ($groups{$item}->{is_xanes} and ($$hash_pointer{fitspace} eq 'k')) {
	$groups{$item}->MAKE("lcf_fitspace" => 'e');
      };

      ## need to initialize these for a group that doesn't have them
      $groups{$item}->{lcf_fitspace} ||= $config{linearcombo}{fitspace};
      $groups{$item}->{lcf_fitmin_k} ||= $config{linearcombo}{fitmin_k};
      $groups{$item}->{lcf_fitmax_k} ||= $config{linearcombo}{fitmax_k};
      $groups{$item}->{lcf_fitmin_e} ||= $config{linearcombo}{fitmin};
      $groups{$item}->{lcf_fitmax_e} ||= $config{linearcombo}{fitmax};
      if ($groups{$item}->{lcf_fitspace} eq 'k') {
	$groups{$item}->{lcf_fitmin} = $groups{$item}->{lcf_fitmin_k};
	$groups{$item}->{lcf_fitmax} = $groups{$item}->{lcf_fitmax_k};
      } else {
	$groups{$item}->{lcf_fitmin} = $groups{$item}->{lcf_fitmin_e};
	$groups{$item}->{lcf_fitmax} = $groups{$item}->{lcf_fitmax_e};
      };
      ## make sure these display correctly and are correctly stored in the
      ## parameters hash
      foreach (qw(fitmin fitmax)) {
	my $key = "lcf_" . $_;
	$widget{$key} -> configure(-validate=>"none");
	$widget{$key} -> delete(0, 'end');
	$widget{$key} -> insert(0, $groups{$item}->{$key});
	$widget{$key} -> configure(-validate=>"key");
	$$hash_pointer{$_} = $groups{$item}->{$key};
      };

      unless ($groups{$item}->{is_xmu}) {
	$widget{lcf_fit} -> configure(-state=>'disabled');
	last FAT;
      };
      $$hash_pointer{fitspace} = $groups{$item}->{"lcf_fitspace"} || $$hash_pointer{fitspace};
      $$hash_pointer{linear}   = $groups{$item}->{"lcf_linear"}   || $$hash_pointer{linear};
      $$hash_pointer{nonneg}   = $groups{$item}->{"lcf_nonneg"}   || $$hash_pointer{nonneg};
      $$hash_pointer{100}      = $groups{$item}->{"lcf_100"}      || $$hash_pointer{100};
      $$hash_pointer{e0all}    = $groups{$item}->{"lcf_e0all"}    || $$hash_pointer{e0all};

      ## it is possible that the groups list has changed of late, so update
      ## the lists of standards
      my @keys = ('None');
      foreach my $k (&sorted_group_list) {
	($groups{$k}->{is_xmu} or $groups{$k}->{is_chi}) and push @keys, $k;
      };
      $$hash_pointer{keys} = \@keys;
      ## when switching groups, use the standards associated with the
      ## group, if available, else use the standards already in the
      ## table
      if (exists $groups{$item}->{lcf_fit} and $groups{$item}->{lcf_fit}) {
	my $any_set = 0;
	foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
	  ++$any_set if (exists($groups{$item}->{"lcf_standard$i"}) and ($groups{$item}->{"lcf_standard$i"} ne 'None'));
	};
	foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
	  my $test = (exists($groups{$item}->{"lcf_standard$i"}) and ($groups{$item}->{"lcf_standard$i"} ne 'None'));
	  $$hash_pointer{"standard$i"} = ($any_set) ? $groups{$item}->{"lcf_standard$i"}  : $$hash_pointer{"standard$i"};
	  $$hash_pointer{"standard$i"} = "None" unless defined $$hash_pointer{"standard$i"};
	  $$hash_pointer{"e0$i"}       = ($any_set) ? $groups{$item}->{"lcf_e0$i"}	  : $$hash_pointer{"e0$i"};
	  $$hash_pointer{"e0val$i"}    = ($any_set) ? $groups{$item}->{"lcf_e0val$i"}     : $$hash_pointer{"e0val$i"};
	  $$hash_pointer{"value$i"}    = ($any_set) ? $groups{$item}->{"lcf_value$i"}     : $$hash_pointer{"value$i"};

	  $widget{"lcf_standard_list$i"} -> delete(0, "end");
	  $widget{"lcf_standard_list$i"} -> insert("end", "0: None");
	  my $j = 1;
	  foreach my $s (@keys) {
	    next if ($s eq 'None');
	    $groups{$s}->MAKE(lcf_menu_label => "$j: $groups{$s}->{label}");
	    $widget{"lcf_standard_list$i"} -> insert("end", "$j: $groups{$s}->{label}");
	    ++$j;
	  };
	  if (not exists $groups{$item}->{"lcf_standard$i"}) {
	    $$hash_pointer{"standard_lab$i"} = "0: None";
	  } elsif ($groups{$item}->{"lcf_standard$i"} eq 'None') {
	    $$hash_pointer{"standard_lab$i"} = "0: None";
	  } else {
	    $$hash_pointer{"standard_lab$i"} = ($any_set) ? $groups{$groups{$item}->{"lcf_standard$i"}}->{lcf_menu_label} : $$hash_pointer{"standard_lab$i"};
	  };
	  ## make sure menu labels are up to date
	  #my $label = "";
	  #($label = $groups{$groups{$current}->{"lcf_standard$i"}}->{lcf_menu_label})
	  #  if (exists $groups{$current}->{"lcf_standard$i"});
	  #$$hash_pointer{"standard_lab$i"} = $label || $$hash_pointer{"standard_lab$i"};
	};
	lcf_results($hash_pointer);
	$widget{lcf_operations} -> entryconfigure(4, -state=>'normal', -style=>$$hash_pointer{normal_style});

      } else {
	$widget{lcf_text} -> delete('1.0', 'end');
      };

      $$hash_pointer{fitmin} = $groups{$item}->{lcf_fitmin};
      $$hash_pointer{fitmax} = $groups{$item}->{lcf_fitmax};
      if ($$hash_pointer{fitspace} eq 'k') {
	$widget{lcf_operations} -> entryconfigure(7, -state=>'normal', -style=>$$hash_pointer{normal_style});
	lcf_quickplot_k($hash_pointer);
      } else {
	$widget{lcf_operations} -> entryconfigure(7, -state=>'disabled', -style=>$$hash_pointer{disabled_style});
	lcf_quickplot_e($hash_pointer);
      };
      my $how = ($groups{$item}->{lcf_fit}) ? 0 : 2;
      lcf_initialize($hash_pointer, $how);
      $widget{lcf_notebook} -> raise('standards') unless ($widget{lcf_notebook}->raised eq 'results');
      ##       if (exists $lcf_data{$item}) {
      ## 	$widget{lcf_notebook} -> pageconfigure('combinatorics', -state=>'normal');
      ## 	lcf_display();
      ##       } else {
      ## 	## empty out both combinatorics tables
      ## 	$widget{lcf_select_table}->delete('all');
      ## 	$widget{lcf_result_table}->delete('all');
      ## 	$widget{lcf_notebook} -> raise('standards');
      ## 	$widget{lcf_notebook} -> pageconfigure('combinatorics', -state=>'disabled');
      ##       };
      last FAT;
    };

    ($fat_showing eq 'sa') and do {
      $widget{safluo_group} -> configure(-text=>$groups{$item}->{label});
      $widget{safluo_elem}  -> configure(-text=>$groups{$item}->{bkg_z});
      $widget{safluo_edge}  -> configure(-text=>$groups{$item}->{fft_edge});
      my $is_xmu = $groups{$item}->{is_xmu};
      $widget{safluo_plot} -> configure(-state=>($is_xmu) ? 'normal' : 'disabled');
      $widget{safluo_make} -> configure(-state=>'disabled');
      $widget{safluo_fluo} -> configure(-state=>'normal');
      unless ($is_xmu) {	# deal with chi(k) record
	($$hash_pointer{algorithm} = "booth") if ($$hash_pointer{algorithm} eq 'fluo');
	$widget{safluo_fluo} -> configure(-state=>'disabled');
      };
      foreach my $k (qw(formula angle_in angle_out thickness)) {
	$$hash_pointer{$k} = $groups{$item}->{"sa_$k"} if ((exists $groups{$item}->{"sa_$k"}) and
							   ($groups{$item}->{"sa_$k"} !~ /^\s*$/));
      };
      if ($$hash_pointer{algorithm} eq 'fluo') {
	$groups{$item}->plotE('emn', $dmode, \%plot_features, \@indicator) if $is_xmu;
	$last_plot = 'e';
	$plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      } elsif ($$hash_pointer{algorithm} =~ /atoms|booth|troger/) {
	my $str = 'k'.$plot_features{k_w};
	$groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
	$last_plot='k';
	$plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      };
      last FAT;
    };

    ($fat_showing eq 'mee') and do {
      my $is_xmu = $groups{$item}->{is_xmu};
      map {$widget{"mee_$_"} -> configure(-state=>($is_xmu) ? 'normal' : 'disabled')}
	qw(store make e k r q);
      my $key = join("_", lc($groups{$item}->{bkg_z}), lc($groups{$item}->{fft_edge}));
      $$hash_pointer{shift} = $groups{$item}->{mee_en} || $mee_energies{energies}{$key} || 100;
      $$hash_pointer{width} = $groups{$item}->{mee_wi} || 10;
      $$hash_pointer{amp}   = $groups{$item}->{mee_am} || 0.01;
      $$hash_pointer{key}   = $key;
      $widget{mee_data} -> configure(-text=>$groups{$item}->{label});
      last FAT;
    };

    ## this section is the demo section, add a new section for a new
    ## analysis chore as appropriate
    ($fat_showing eq 'demo') and do {
      ## update the "unknown" with this label, if needed
      $widget{foobar_unknown} -> configure(-text=>$groups{$item}->{label});
      ## you may wish to fret about the standard and unknown being the
      ## same group and do something sensible

      ## set any other foobar_params as needed using
      ## $$hash_pointer{whatever} = "whatever";

      ## do you need to make a plot?  it is best to use a plotting
      ## method and don't forget to set the $last_plot global variable
      ## so the pluck buttons work correctly
      last FAT;
    };

    ($fat_showing eq 'series') and do {
      my $this = $$hash_pointer{param};
      $$hash_pointer{group} = $current;
      $$hash_pointer{label}   = $groups{$current}->{label};
      $$hash_pointer{current} = sprintf("%.3f", $groups{$current}->{$this});
      $$hash_pointer{begin}   = sprintf("%.3f", $groups{$current}->{$this});
      last FAT;
    };

    ($fat_showing eq 'teach_ft') and do {
      last FAT;
    };

    ## this is what is done if the normal view is showing.
    do {
      last FAT         if ($config{general}{groupreplot} eq 'none');
      plot_current_e() if ($config{general}{groupreplot} eq 'e');
      plot_current_k() if ($config{general}{groupreplot} eq 'k');
      plot_current_r() if ($config{general}{groupreplot} eq 'r');
      plot_current_q() if ($config{general}{groupreplot} eq 'q'); #  ()
      last FAT;
    };

  };  # end of non-normal display switch


  ## and finally, put titles in the title display
  if ($prev and defined $groups{$prev}) {
    refresh_titles($groups{$prev}) unless (($prev eq 'Default Parameters') or
					   ($current eq 'Default Parameters'));
  };
  $notes{titles} -> configure(-state=>'normal');
  $notes{titles} -> delete(qw/1.0 end/);
  unless ($item eq "Default Parameters") {
    $groups{$item} -> get_titles;
    foreach (@{$groups{$item}->{titles}}) {
      $notes{titles} -> insert('end', $_."\n", "text");
    };
  };

  sanity_check($item) if ((not $reading_project) and (not $saving) and ($fat_showing eq 'normal'));

  $top -> Unbusy unless $is_busy;
  return unless ($fat_showing eq 'normal');
  ($how == 1) or Echonow("displaying parameters for group \"$groups{$item}->{label}\" ... done.");
};

sub sanity_check {
  my $item = shift;
  my $problems = $groups{$item}->sanity;
  if ($problems) {
    Error("Athena has found suspicious values for one or more parameters.  Please check the indicated value.");
    my $d = $top->DialogBox(-title   => "Athena: Suspicious parameter values!",
			    -buttons => ["OK"],
			    -popover => 'cursor');
    my $r = $d -> add('ROText',
		      -font=>$config{fonts}{fixed},
		     )
      -> pack();
    $r -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
    $r -> insert('1.0', $problems, 'text');
    $r -> insert('1.0', "The following problems were found for group \"$groups{$item}->{label}\"\n\n", 'text');
    $r -> insert('end', "\nYou should fix these values before continuing analysis of these data.\n", 'text');
    $d -> Show;
    #print $problems;
    return 1;
  };
  return 0;
};


## END OF SET PROPERTIES SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2010 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  reading in data and project files

## file reading wrapper...
##   ## read from the command line?  from the web?
##   ## unless (($_[0] and -e $_[0]) or ($_[0] and $_[0] =~ /^http:/)) {
sub read_file {
  my $get_many = $_[0] || 0;
  my $read_arg = $_[1] || 0;
  ($get_many =~ /HASH/) and ($get_many=0);
  $preprocess{ok} = 0;
  my $save_groupreplot = $config{general}{groupreplot};
  $config{general}{groupreplot} = 'none';
  my @data;
  if ($read_arg) {
    push @data, $read_arg;
  } elsif (($Tk::VERSION < 804) and ($get_many)) {
    @data = &get_file_list;
  } elsif ($Tk::VERSION < 804) {
    $data[0] = &get_single_file;
  } else {
    @data = &get_single_file;
  };
  return unless ((@data) and ($data[0]) and ($data[0] !~ /^\s*$/));
  $top -> Busy(-recurse=>1,);
  my ($raw, $cancel) = (undef, 0);
  #$prior_args = [];
  my ($first, $count) = ("", 1);
  my $errmsg;
  my $project_no_prompt = 0;
 DATA: foreach my $thisfile (@data) {
    next unless (($thisfile) and ($thisfile !~ /^\s*$/));
    unless (-r $thisfile) {
      if (-e $thisfile) {
	$errmsg = "Could not read \"$thisfile\" (check permissions)";
	$top -> Dialog(-bitmap  => 'error',
		       -text    => $errmsg,
		       -title   => 'Athena: Error reading file',
		       -buttons => ['OK'],
		       -default_button => "OK" )
	  -> Show();
	Error($errmsg);
      } else {
	$errmsg = "Could not read \"$thisfile\" (file does not exist)";
	$top -> Dialog(-bitmap  => 'error',
		       -text    => $errmsg,
		       -title   => 'Athena: Error reading file',
		       -buttons => ['OK'],
		       -default_button => "OK" )
	  -> Show();
	Error($errmsg);
      };
      $cancel = 1;
      next DATA
    };

    Archive::Zip::setErrorHandler( \&is_zip_error_handler );
    my $zip = Archive::Zip->new();
    ##print $zip->read($thisfile), $/;
    my $is_zipstyle = ($zip->read($thisfile) == AZ_OK) ? 1 : 0;
    my $is_artemis = ($is_zipstyle) ? $zip->membersMatching(/HORAE/) : 0;
    ##print "$thisfile|$is_zipstyle|$is_artemis\n";
    undef $zip;
    Archive::Zip::setErrorHandler( undef );
    if ($is_artemis) {
      $errmsg = "Oops!  $thisfile seems to be an Artemis project file.";
      $top -> Dialog(-bitmap  => 'error',
		     -text    => $errmsg,
		     -title   => 'Athena: Error reading file',
		     -buttons => ['OK'],
		     -default_button => "OK" )
	-> Show();
      Error($errmsg);
      $cancel = 1;
      next DATA;
    };
    if ($is_zipstyle) {
      $errmsg = "$thisfile is not a valid data file.";
      $top -> Dialog(-bitmap  => 'error',
		     -text    => $errmsg,
		     -title   => 'Athena: Error reading file',
		     -buttons => ['OK'],
		     -default_button => "OK" )
	-> Show();
      Error($errmsg);
      $cancel = 1;
      next DATA;
    };


    # does this one have mac line-endings?
#     my $was_mac = $groups{"Default Parameters"} ->
#       fix_mac($thisfile, $stash_dir, lc($config{general}{mac_eol}), $top);
#     Echo("\"$thisfile\" had Macintosh EOL characters and was skipped."), next DATA if ($was_mac eq '-1');
#     Echo("\"$thisfile\" had Macintosh EOL characters and was fixed.") if ($was_mac eq '1');
    my $is_record = (Ifeffit::Files->is_record($thisfile));
    my ($is_mac, $tempfile) = (0, q{});
    if (not $is_record) {
      local( $/, *FH ) ;
      open( FH, $thisfile ) or die "sudden flaming death\n";
      my $snarf = <FH>;
      close(FH);
      if (($snarf !~ m{SSRL\s+\-?\s+EXAFS Data Collector}) and ($snarf =~ m{\r(?!\n)})) { # this matches Mac EOL but not Windows
	Echo("Correcting Mac line termination for $thisfile");
	$tempfile =  File::Spec->catfile($stash_dir, "unmacify_".basename($thisfile));
	$snarf =~ s{\r(?!\n)}{\n}g;
	open TF, ">",$tempfile;
	print TF $snarf;
	close TF;
	$is_mac = 1;
      };
    };
    my $thisfile_notmac = ($is_mac) ? $tempfile : $thisfile;

    my @foo = %marked;
    my $empty = $#foo;
    my $safe_message_issued = 0;
    my %stash;
    my %map;
    if ($is_record) {
      my $fname = $thisfile_notmac;
      my %group_map = ();
      my ($imported, $total) = (0,0);
      my $frame = examine_project($fname, \%group_map, \$cancel, \$project_no_prompt);
      ($frame == 0) or $frame -> waitWindow();
      last DATA if ($cancel);
      my $nrecords = 0;
      $reading_project = 1;
      ##open R, $fname or die "Could not open $thisfile_notmac as a record or project\n";
      my $gz = gzopen($fname, "rb") or die "could not open $fname as an Athena project\n";
      my $line;
      use vars qw($old_group @args @x @y @journal @stddev @i0 %foo);
      while ($gz->gzreadline($line) > 0) {
	next if ($line =~ /^\s*\#/);
	next if ($line =~ /^\s*$/);
	next if ($line =~ /^\s*1/);
	#if ($is_windows) {
	if ($always_false) {

	  ## eval each line directly -- NOT SAFE!!
	  Echo("Reading project file with direct evaluations") unless $safe_message_issued;
	  $safe_message_issued = 1;
	WINDOWS: {
	    ($line =~ /^\@journal/) and do {
	      eval $line;
	      foreach (@journal) {
		$notes{journal} -> insert('end', $line."\n", "text");
	      };
	      last WINDOWS;
	    };
	    ($line =~ /^\%plot_features/) and do {

	      (my $this = $line) =~ s/^\%plot_features/\%foo/;
	      eval $this;
	      foreach my $k (keys %foo) {
		next unless ($k =~ /[ekqr]((_\w+)|(m(ax|in)))/);
		$plot_features{$k} = $foo{$k};
	      };
	      ($plot_features{e_marked} = 'n') if ($plot_features{e_marked} eq 'd');
	      last WINDOWS;
	    };
	    ($line =~ /^\@indicator/) and do {
	      (my $this = $line) =~ s/^\@indicator\s+=\s+//;
	      my @indic = eval $this;
	      foreach (1 .. $#indic) {
		$indicator[$_]->[1] = $indic[$_]->[1];
		$indicator[$_]->[2] = $indic[$_]->[2];
	      };
	      #print Data::Dumper->Dump([\@indicator], [qw/indicator/]);
	      last WINDOWS;
	    };
	    ($line =~ /^\%lcf_data/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\$old_group/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\@args/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\@x/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\@y/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\@stddev/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    ($line =~ /^\@i0/) and do {
	      eval $line;
	      last WINDOWS;
	    };
	    (($line =~ /^\[record\]/) or ($line =~ /^\&read_record/)) and do {
	      my $memory_ok = $groups{"Default Parameters"}
		-> memory_check($top, \&Echo, \%groups, $max_heap, 0, 1);
	      Echo ("Out of memory in Ifeffit"), last DATA if ($memory_ok == -1);
	      my $gp = &read_record(0, $fname, $old_group, \@args, \@x, \@y, \@stddev, \@i0);
	      $map{$old_group} = $gp;
	      $first ||= $gp;
	      ++$nrecords;
	      $old_group = ""; @args = (); @x = ();  @y = (); @journal = (); @stddev = (); @i0 = (); %foo = ();
	      last WINDOWS;
	    };
	    1;
	  };

	} else {

	  ## read each line in a Safe compartment
	  Echo("Reading project file in a safe compartment") unless $safe_message_issued;
	  $safe_message_issued = 1;
	  my $cpt = new Safe;
	NOT_WINDOWS: {
	    ($line =~ /^\@journal/) and do {
	      @ {$cpt->varglob('journal')} = $cpt->reval($line);
	      @journal = @ {$cpt->varglob('journal')};
	      foreach (@journal) {
		$notes{journal} -> insert('end', $_."\n", "text");
	      };
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\%plot_features/) and do {
	      $line =~ s{^\%}{\@};
	      @ {$cpt->varglob('plot_features')} = $cpt->reval($line);
	      my @list = @ {$cpt->varglob('plot_features')};
	      while (@list) {	# only set the things in the plot
		my ($k, $v) = (shift @list, shift @list); # options area
		next unless ($k =~ /[ekqr]((_\w+)|(m(ax|in))|w)/);
		$plot_features{$k} = $v;
	      };
	      ($plot_features{e_marked} = 'n') if ($plot_features{e_marked} eq 'd');
	      delete $plot_features{project};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@indicator/) and do {
	      @ {$cpt->varglob('indicator')} = $cpt->reval($line);
	      my @indic = @ {$cpt->varglob('indicator')};
	      foreach (1 .. $#indic) {
		$indicator[$_]->[1] = $indic[$_]->[1];
		$indicator[$_]->[2] = $indic[$_]->[2];
	      };
	      #print Data::Dumper->Dump([\@indicator], [qw/indicator/]);
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\%lcf_data/) and do {
	      my $this = $line;
	      my $regex = join("|", (keys %map));
	      #print $regex;
	      $this =~ s/\b($regex)\b/$map{$1}/g;
	      % {$cpt->varglob('lcf_data')} = $cpt->reval($this);
	      %lcf_data = % {$cpt->varglob('lcf_data')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\$old_group/) and do {
	      $ {$cpt->varglob('old_group')} = $cpt->reval($line);
	      $old_group = $ {$cpt->varglob('old_group')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@args/) and do {
	      @ {$cpt->varglob('args')} = $cpt->reval($line);
	      @args = @ {$cpt->varglob('args')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@x/) and do {
	      @ {$cpt->varglob('x')} = $cpt->reval($line);
	      @x = @ {$cpt->varglob('x')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@y/) and do {
	      @ {$cpt->varglob('y')} = $cpt->reval($line);
	      @y = @ {$cpt->varglob('y')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@stddev/) and do {
	      @ {$cpt->varglob('stddev')} = $cpt->reval($line);
	      @stddev = @ {$cpt->varglob('stddev')};
	      last NOT_WINDOWS;
	    };
	    ($line =~ /^\@i0/) and do {
	      @ {$cpt->varglob('i0')} = $cpt->reval($line);
	      @i0 = @ {$cpt->varglob('i0')};
	      last NOT_WINDOWS;
	    };
	    (($line =~ /^\[record\]/) or ($line =~ /^\&read_record/)) and do {
	      ++$total;
	      last NOT_WINDOWS if not $group_map{$old_group}; # from examine_project
	      ++$imported;
	      my $memory_ok = $groups{"Default Parameters"}
		-> memory_check($top, \&Echo, \%groups, $max_heap, 0, 1);
	      Echo ("Out of memory in Ifeffit"), last DATA if ($memory_ok == -1);
	      my $gp = read_record(0, $fname, $old_group, \@args, \@x, \@y, \@stddev, \@i0);
	      $map{$old_group} = $gp;
	      $first ||= $gp;
	      ++$nrecords;
	      $old_group = ""; @args = (); @x = ();  @y = (); @journal = (); @stddev = (); @i0 = (); %foo = ();
	      last NOT_WINDOWS;
	    };
	    1;
	  };
	};
      };
      $reading_project = 0;
      $gz->gzclose();
      ##close R;
      unless ($nrecords) {
	$top->Unbusy;
	Echo("The project file \"$fname\" contained no records.");
	return;
      };
      my $complete = ($total == $imported);
      &push_mru($thisfile, 1, 1, $complete);
      project_state(1) if ($empty == -1);


      &set_properties(1, $first||$current, 0);
    SWITCH: {
	($groups{$first}->{is_xmu}) and do {
	  &plot_current_e;
	  last SWITCH;
	};
	($groups{$first}->{is_chi}) and do {
	  my $str = sprintf('k%1d', $plot_features{kw}); #$groups{$first}->{fft_kw});
	  &plot_current_k;
	  last SWITCH;
	};
      };

##       foreach my $g (keys %groups) {
## 	next if ($g eq "Default Parameters");
## 	print $groups{$g}->{group}, " ", $groups{$g}->{old_group}, "\n";
##       };

      ## restore purple mark buttons and fix up background standards,
      ## reference channels, and lcf standards
      foreach my $k (keys %groups) {
	next if ($k eq "Default Parameters");
	## mu_str
	if (exists($groups{$k}->{mu_str}) and $groups{$k}->{is_proj}) {
	  my $mustr = $groups{$k}->{mu_str};
	  my $old   = $groups{$k}->{old_group};
	  $mustr =~ s/\b$old\b/$k/g;
	  $groups{$k}->MAKE(mu_str=>$mustr);
	};
	## mark buttons
	if (exists($groups{$k}->{project_marked}) and
	    $groups{$k}->{project_marked}) {
	  $marked{$k} = 1;
	  $groups{$k}->{checkbutton} -> select;
	};
	## background standards
	unless ((exists $groups{$k}->{bkg_stan}) and
		($groups{$k}->{bkg_stan} eq 'None')) {
	STAN: foreach my $kk (keys %groups) {
	    next if ($kk eq "Default Parameters");
	    ##print join(" ", $k, $groups{$k}->{bkg_stan}, $kk, $groups{$kk}->{old_group}), $/;
	    if ((exists $groups{$k}->{bkg_stan})   and
		(exists $groups{$kk}->{old_group}) and
		($groups{$k}->{bkg_stan} eq $groups{$kk}->{old_group})) {
	      $groups{$k}->MAKE(bkg_stan=>$kk);
	      last STAN;
	    };
	  };
	};
	## reference channels
	if ($groups{$k}->{reference}) {
	  my $found = 0;
	INNER: foreach my $o (keys %groups) {
	    next if ($o eq "Default Parameters");
	    next if ($o eq $k);
	    next unless exists $groups{$o}->{old_group};
	    if ((exists $groups{$k}->{reference}) and
		(exists $groups{$o}->{old_group}) and
		($groups{$k}->{reference} eq $groups{$o}->{old_group})) {
	      $groups{$k}->MAKE(reference=>$o);
	      $found = 1;
	      last INNER;
	    };
	  };
	  $groups{$k}->MAKE(reference=>0) if
	    ((not $found) and ## in case of partial project import
	     (not exists($groups{$groups{$k}->{reference}}))); # already in project
	};
	## linear combination fitting standards
	if ($groups{$k}->{lcf_fit}) {
	  my @keys = ();
	  foreach my $kk (&sorted_group_list) {
	    ($groups{$kk}->{is_xmu} or $groups{$kk}->{is_chi}) and push @keys, $kk;
	  };

	LCF: foreach my $o (keys %groups) {
	    next if ($o eq "Default Parameters");
	    next if ($o eq $k);

	    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
	      next unless (exists $groups{$k}->{"lcf_standard$i"});
	      next if ($groups{$k}->{"lcf_standard$i"} eq 'None');
	      next unless (exists $groups{$o}->{old_group});
	      if ($groups{$k}->{"lcf_standard$i"}  eq $groups{$o}->{old_group}) {
 		my $ii = 0;
 		foreach my $ke (@keys) { # find the index of this standard
 		  ++$ii;
 		  last if ($ke eq $o);
 		};
		$groups{$k}->MAKE("lcf_standard$i"     => $o,
				  "lcf_standard_lab$i" => $ii . ": " . $groups{$o}->{label});
	      };
	      if ((exists $groups{$k}->{"lcf_standard$i"}) and
		  (not exists $groups{$o}->{old_group})) {
		$groups{$k}->MAKE("lcf_standard$i"     => 'None',
				  "lcf_standard_lab$i" => '0: None',
				  "lcf_e0$i"           => 0,
				  "lcf_e0val$i"        => 0,
				  "lcf_value$i"        => 0,
				 );
	      };
	      ##print "$i  ", $groups{$k}->{label}, " ", $groups{$k}->{"lcf_standard_lab$i"}, $/;
	    };
	  };
	};
      };
      foreach my $o (keys %stash) {
	foreach my $k (%groups) {
	  next unless (exists $groups{$k}->{old_group});
	  next unless ($groups{$k}->{old_group} eq $o);
	  $lcf_data{$k} = $stash{$o};
	};
# 	my @order = map { $map{$_} } @{ $stash{$o}{order} };
# 	$stash{$o}{order} = \@order;
# 	my @results = @ {$stash{$o}{results}};
# 	my @fixed;
# 	foreach my $r (@results) {
# 	  my $r->[0]
# 	};
      };
    } else {
      #my $foo = $thisfile_notmac;
      ($raw, $prior_string) = read_raw($thisfile_notmac, $thisfile, $prior_string, $prior_args, \$cancel, \$count);
      ($raw == 0) or $raw -> waitWindow();
      last DATA if ($cancel);
      ++$count;
      $top->update;
    };
  };
  ## unset extra import features
  #$rebin{do_rebin}	= 0;
  $preprocess{standard}	||= 'None';
  #$preprocess{mark_do}	= 0;
  #$preprocess{trun_do}	= 0;
  #$preprocess{deg_do}	= 0;

  $preprocess{raised} ||= "reference";
  $rebin{titles}	= [];
  $preprocess{titles}	= [];

  section_indicators();

  $top->Unbusy, return if $cancel;
  $current and &set_properties(1, $first||$current,0);
  $config{general}{groupreplot} = $save_groupreplot;
  # finally adjust the view
  if (exists($groups{$current}->{text})) {
    my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
    ($here < 0) and ($here = 0);
    my $full = ($list->bbox(@skinny_list))[3] + 5;
    $list -> yview('moveto', $here/$full);
  };
  $top->Unbusy;
};


## fetch a list of files using FileSelect
sub get_file_list {
  ## read from the command line?  from the web?
  ## unless (($_[0] and -e $_[0]) or ($_[0] and $_[0] =~ /^http:/)) {
  require Cwd;
  my $path = $current_data_dir || Cwd::cwd;
  my $FSel  = $top->FileSelect(-title => 'Athena: open MANY data files',
			       -width => 40,
			       -directory=>$path);
  $FSel -> configure(-selectmode=>'extended');
  my @data = $FSel->Show;
  return sort @data;
};

## fetch a single file using getOpenFile
sub get_single_file {
  ## read from the command line?  from the web?
  ## unless (($_[0] and -e $_[0]) or ($_[0] and $_[0] =~ /^http:/)) {
  require Cwd;
  #local $Tk::FBox::a;
  #local $Tk::FBox::b;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [['All Files',            '*'],
	       ['data files',          ['.dat', '.xmu']],
	       ['chi(k) files',         '.chi'],
	       ['Athena project files', '.prj'],
	      ];
  if ($Tk::VERSION > 804) {
    my $file = $top -> getOpenFile(-filetypes=>$types,
				   #(not $is_windows) ?
				   #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				   -initialdir=>$path,
				   -multiple => 1,
				   -title => "Athena: Open one or more data files");
    $file ||= [];
    return sort @$file;
  } else {
    my $file = $top -> getOpenFile(-filetypes=>$types,
				   #(not $is_windows) ?
				   #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				   -initialdir=>$path,
				   -title => "Athena: Open a SINGLE data file");
    $file ||= q{};
    return $file;
  };
};


sub read_demo {
  require Cwd;
  #local $Tk::FBox::a;
  #local $Tk::FBox::b;
  my $path = $groups{"Default Parameters"} -> find('athena', 'demos');
  my $types = [['Athena project files', '.prj'],
	       ['All Files',            '*'],
	      ];
  my $file = scalar $top -> getOpenFile(-filetypes=>$types,
					#(not $is_windows) ?
					#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
					-initialdir=>$path,
					-multiple => 0,
					-title => "Athena: Open a demo project");
  if ($file) {
    read_file(0,$file);
    raise_palette('journal');
  };
};

## read a file as raw data.  This means to prompt for column selection.
sub read_raw {

  my $red = $config{colors}{single};

  my ($data, $orig, $prior_string, $prior_args, $r_cancel, $rcount) = @_;
  my $count = $$rcount;
				## look at first file in list to see
				## if this is a record or raw dat
  my $memory_ok = $groups{"Default Parameters"}
    -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 1);
  Echo ("Out of memory in Ifeffit"), return (-1, $prior_string) if ($memory_ok == -1);

  ## bad things happen if the data file name is longer than 128
  ## characters.  when this happens, transfer the file to the stash
  ## directory so ifeffit can read it from there.  if the filename is
  ## not too long, then $stash and $data will be the same
  my $stash = $data;
  my $is_binary = 0;

 PLUGINS: foreach my $p (sort {$a cmp $b} @plugins) {
    next PLUGINS unless $plugin_params{$p}{_enabled};
    if (eval "Ifeffit::Plugins::Filetype::Athena::$p->is('$data')") {
      Echo("$data seems to be a $p data file.");
      $stash = eval "Ifeffit::Plugins::Filetype::Athena::$p->fix('$data', '$stash_dir', \$top, \$plugin_params{$p});";
      if (not $stash) {
	$$r_cancel = 1;
	set_status(0);
	Echo("$data could not be read as a $p data file.");
	return (0, $prior_string);
      };
      my $file = $groups{"Default Parameters"} -> find('athena', 'plugins');
      tied( %plugin_params )->WriteConfig($file);
      eval "\$is_binary = \$Ifeffit::Plugins::Filetype::Athena::${p}::is_binary";
      last PLUGINS;
    };
  };
  if ($stash =~ /\#/) {
    my ($nme, $pth, $suffix) = fileparse($stash);
    $nme =~ s/\#//g;
    my $new = File::Spec->catfile($stash_dir, $nme);
    ($new = File::Spec->catfile($stash_dir, "toss")) if (length($new) > 127);
    copy($stash, $new);
    $stash = $new;
  };
  if (length($stash) > 127) {
    my ($nme, $pth, $suffix) = fileparse($stash);
    my $new = File::Spec->catfile($stash_dir, $nme);
    ($new = File::Spec->catfile($stash_dir, "toss")) if (length($new) > 127);
    copy($stash, $new);
    $stash = $new;
  };

  my %label_map = (e=>'mu(E)', n=>'norm(E)', k=>'chi(k)', d=>'detector',
		   x=>'xmu.dat', c=>'chi.dat', a=>'xanes(E)');
  my ($name, $pth, $suffix) = fileparse($data, qw(\. \.dat \.chi \.xmu));
  my $databox;
  #my $group = $name;
  my $group = $name.$suffix;
  my $label;
  ($group, $label) = group_name($group);
  ##$groups{$current} -> dispose("read_data(file=\"$data\", group=$group)\n", $dmode);
  my $is_xmudat = Ifeffit::Files->is_xmudat($stash, $top);
  my $is_pixel  = ($config{pixel}{do_pixel_check}) ?
    Ifeffit::Files->is_pixel($stash) : 0;
  my $is_xanes = 0;
  ($is_xanes = Ifeffit::Files->is_xanes($stash, 100)) if $config{xanes}{cutoff};
  if ($stash ne $data) {
    $groups{"Default Parameters"} -> dispose("## actual file: $data\n");
    $groups{"Default Parameters"} -> dispose("## transfered to stash file: $stash\n");
  };
  $groups{"Default Parameters"} -> dispose("\n## Reading a data file in the column selection dialog\n");
  if ($is_xmudat) {
    $groups{"Default Parameters"} -> dispose("read_data(file=\"$stash\", group=$group, type=xmu.dat, no_sort)\n", $dmode);
  } else {
    $groups{"Default Parameters"} -> dispose("read_data(file=\"$stash\", group=$group, no_sort)\n", $dmode);
  };
  unless (Ifeffit::Files->is_datafile) {
    $top -> Dialog(-bitmap  => 'error',
		   -text    => "\`$data\' could not be read by ifeffit as a data file",
		   -title   => 'Athena: Error reading file',
		   -buttons => ['OK'],
		   -default_button => "OK" )
      -> Show();
    ## delete title lines from ifeffit for $group
    $$r_cancel = 0;
    set_status(0);
    return (0, $prior_string);
  };
  my $str = &column_string;
  my $suff = (split(" ", $str))[0];
  $groups{"Default Parameters"} -> dispose("set ___n = npts($group.$suff)", $dmode);
  my $nn = Ifeffit::get_scalar("___n");
  if ($nn <= $config{general}{minpts}) {
    $top -> Dialog(-bitmap  => 'error',
		   -text    => "\`$data\' has fewer than " .
		   $config{general}{minpts} . " data points.",
		   -title   => 'Athena: Error reading file',
		   -buttons => ['OK'],
		   -default_button => "OK" )
      -> Show();
    ## delete title lines from ifeffit for $group
    $$r_cancel = 0;
    set_status(0);
    --$count;
    return (0, $prior_string);
  };

  &push_mru($orig, 1);

  ## the heuristic for deciding if the interpretation of the columns
  ## has changed is the value of ifeffit's column_label variable.  I
  ## presume that if this is unchanged between successive files, then
  ## I can interpret the columns identically.  This is a decent
  ## heuristic for data with labeled columns, but can be trouble for
  ## unlabeled columns.  In that case, the arrays are called $group.1,
  ## $group.2, etc.
  my $col_string = &column_string;
    ## this is trouble -- need to know difference between one file and many files
  if (($count > 1) and ($col_string eq $prior_string)) {
    construct_xmu(0, $group, $label, $data, $stash, $prior_args);
    return (0, $col_string);
  };
  ## If the column lables are different, then go ahead and set up the
  ## column selection palette...
  my @cols = split(" ", $col_string);
  my $raw = $top->Toplevel(-class=>'horae');
  $raw -> geometry($1) if $colsel_geometry =~ /([-+]\d+[-+]\d+)/;
  $raw -> title('Athena: data columns');
  $raw -> protocol(WM_DELETE_WINDOW => sub{$colsel_geometry = $raw->geometry; $$r_cancel = 1; $raw->destroy; return (-1, $prior_string)});
  $raw -> packPropagate(1);
  $raw -> bind('<Control-q>' => sub{$colsel_geometry = $raw->geometry; $$r_cancel = 1; $raw->destroy; return (-1, $prior_string)});
  $raw -> bind('<Control-d>' => sub{$colsel_geometry = $raw->geometry; $$r_cancel = 1; $raw->destroy; return (-1, $prior_string)});
  my ($fnlabel, $enlabel, $unlabel);
  my $grey= '#9c9583';
  my $active_color = $config{colors}{activehighlightcolor};
  ##my $preproc_state = (scalar(keys %groups) == 1) ? 'disabled' : 'normal';
  my $preproc_state = 'normal';
  my $preproc_number = scalar(keys %groups);
  #($preproc_state = 'disabled') if ($current eq "Default Parameters");
  my ($energy, %numerator, %denominator, $mustr, $enstr, %widg, %reference);
  my ($j, $do_ln, $invert, $multi, $xmustring, $space, $space_label, $evkev, $sort, $sorted) =
    (1, 0, 0, 0, "1", 'e', "mu(E)", 'ev', 1, "");
  %reference  = (numerator=>0, denominator=>0, ln=>1, same=>1);
				## build a grid of radio and check
				## buttons for selecting columns from
				## which to construct mu(E)
  my $left  = $raw -> Frame() -> pack(-side=>'left',  -anchor=>'n');
  my $right = $raw -> Frame() -> pack(-side=>'right', -anchor=>'n', -expand=>1, -fill=>'both');
  ($widg{left}, $widg{right}, $widg{raw}) = ($left, $right, $raw);

  my $fr = $left -> Scrolled('Pane', -relief=>'groove', -borderwidth=>2,
			     -gridded=>'xy',
			     -scrollbars=>'os', -sticky => 'we',)
    -> pack(-expand=>1, -fill=>'x');
  $fr->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
  $fr -> Label(-text=>' ', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $fr -> Label(-text=>'Energy', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $fr -> Label(-text=>'Numerator', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $fr -> Label(-text=>'Denominator', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  my @toss;
  ## regexes that attempt to recognize common labels for the i0, it, and if
  ## channels
  my %re = (i0 => $config{general}{i0_regex},
	    it => $config{general}{transmission_regex},
	    if => $config{general}{fluorescence_regex},  );
  if ($config{general}{match_as} eq 'glob') {
    $re{i0} = glob_to_regex($config{general}{i0_regex});
    $re{it} = glob_to_regex($config{general}{transmission_regex});
    $re{if} = glob_to_regex($config{general}{fluorescence_regex});
  };
  my %parts = (0=>0, t=>0, f=>0);
  ##   $Data::Dumper::Indent = 2;
  ##   print Data::Dumper->Dump([$prior_args],[qw(*prior_args)]);
  ##   $Data::Dumper::Indent = 0;
  my $match = 0;
  foreach (@cols) {
    my $this = $group.".".$_;
    ($numerator{$this}, $denominator{$this}) = (0,0);

    if ($$prior_args{old}) { 	# check to see if column labels are
                                # the same as the previous group
      my $old = $$prior_args{old};
      $old = (split(/\./, $old))[0];
				## the keys of the hashes are of the form
				## group.col rather than just col
      (my $that = $this) =~ s/$group/$old/;
      ($energy = $this) if ($that eq $$prior_args{old});
      $numerator{$this}   = $$prior_args{numerator}->{$that} || 0;
      $denominator{$this} = $$prior_args{denominator}->{$that} || 0;
      $match += $numerator{$this} + $denominator{$this};

      ($reference{numerator}   = $this) if ($$prior_args{ref}->{numerator}   eq $that);
      ($reference{denominator} = $this) if ($$prior_args{ref}->{denominator} eq $that);

    };

    $fr -> Label(-text=>$_)
      -> grid(-row=>0, -column=>$j);
    my $jj = $j;  # need a counter that is scoped HERE
    $fr -> Radiobutton(-variable=>\$energy, -value=>$this, -selectcolor=>$red,
		       -command =>
		       sub{
			 $$prior_args{old}	    = $energy;
			 $$prior_args{numerator}    = \%numerator;
			 $$prior_args{denominator}  = \%denominator;
			 $$prior_args{do_ln}	    = $do_ln;
			 $$prior_args{invert}	    = $invert;
			 $$prior_args{space}	    = $space;
			 $$prior_args{evkev}	    = $evkev;
			 $$prior_args{is_xmudat}    = $is_xmudat;
			 $$prior_args{sort}	    = $sort;
			 $$prior_args{multi}	    = $multi;
			 $$prior_args{ref}	    = \%reference;
			 ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
			 $sort=$jj;
		       })
      -> grid(-row=>1, -column=>$j,);
    $fr -> Checkbutton(-variable=>\$numerator{$this}, -selectcolor=>$red, -command=>
		       sub{
			 $$prior_args{old}	    = $energy;
			 $$prior_args{numerator}    = \%numerator;
			 $$prior_args{denominator}  = \%denominator;
			 $$prior_args{do_ln}	    = $do_ln;
			 $$prior_args{invert}	    = $invert;
			 $$prior_args{space}	    = $space;
			 $$prior_args{evkev}	    = $evkev;
			 $$prior_args{is_xmudat}    = $is_xmudat;
			 $$prior_args{sort}	    = $sort;
			 $$prior_args{multi}	    = $multi;
			 $$prior_args{ref}	    = \%reference;
			 ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
			 my $sum = 0;
			 foreach my $v (values %numerator) {$sum += $v};
			 $widg{multi} -> configure(-state=>($sum > 1)?'normal':'disabled');
		       })
      -> grid(-row=>2, -column=>$j,);
    $fr -> Checkbutton(-variable=>\$denominator{$this}, -selectcolor=>$red, -command=>
		       sub{
			 $$prior_args{old}	    = $energy;
			 $$prior_args{numerator}    = \%numerator;
			 $$prior_args{denominator}  = \%denominator;
			 $$prior_args{do_ln}	    = $do_ln;
			 $$prior_args{invert}	    = $invert;
			 $$prior_args{space}	    = $space;
			 $$prior_args{evkev}	    = $evkev;
			 $$prior_args{is_xmudat}    = $is_xmudat;
			 $$prior_args{sort}	    = $sort;
			 $$prior_args{multi}	    = $multi;
			 $$prior_args{ref}	    = \%reference;
			 ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
		       })
      -> grid(-row=>3, -column=>$j,);
    ++$j;
  };

  ## $match>0 means that the columns used in the last imported file match this
  ## file.  If there is no match, then need to rely upon the regexes for
  ## i0, it, if
  #if ($match) {
  if ($col_string eq $prior_string) {
    $do_ln	   = $$prior_args{do_ln}  || 0;
    $invert	   = $$prior_args{invert} || 0;
    $space	   = $$prior_args{space}  || 'e';
    $space_label   = $label_map{$space};
    $evkev	   = $$prior_args{evkev}  || 'ev';
    $sort	   = $$prior_args{sort}   || 1;
    $multi	   = $$prior_args{multi}  || 0;
    %reference     = (numerator   => $reference{numerator}   || $$prior_args{ref}{numerator}   || 0,
		      denominator => $reference{denominator} || $$prior_args{ref}{denominator} || 0,
		      ln          => $$prior_args{ref}->{ln},
		      same        => $$prior_args{ref}->{same},
		     );
    $sorted      = $$prior_args{sorted} || "";
    ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
  } else {

    ## reset all the preprocessing stuff if this one is different
    $rebin{do_rebin}	  = 0;
    $preprocess{standard} = 'None';
    $preprocess{mark_do}  = 0;
    $preprocess{trun_do}  = 0;
    $preprocess{deg_do}	  = 0;
    $preprocess{raised}	  = 'reference';

    %reference  = (numerator=>0, denominator=>0, ln=>1, same=>1);
    $$prior_args{evkev}  = 'ev';
    foreach (@cols) {
      my $this = $group.".".$_;
      (/^(e|en|energy)/i) and ($energy = $this);
      (/^[Kk]$/)   and ($energy = $this);
      (/$re{i0}/i) and ($parts{0} = $this);
      if (/$re{it}/i) {$parts{t} = $this}
      elsif (/$re{if}/i) {$parts{f} = $this};
    };
    $energy ||= $group.".".$cols[0]; # set it if not already set

    if ($parts{t}) {
      $denominator{$parts{t}} = 1;
      ($parts{0}) and ($numerator{$parts{0}} = 1);
      $do_ln = 1;
      ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
    } elsif ($parts{f}) {
      $numerator{$parts{f}} = 1;
      ($parts{0}) and ($denominator{$parts{0}} = 1);
      $do_ln = 0;
      ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
    }
  };

  $energy ||= $group.".".$cols[0]; # set it if not already set
  if ($#cols == 1) {		# mu(E) or chi(k) data
    $$prior_args{evkev}  = 'ev';
    $numerator{$group.".".$cols[1]} = 1;
    ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
  } elsif (($#cols == 3) and ($cols[1] eq 'chi')) { # probably a chi.dat file
    $numerator{$group.".".$cols[1]} = 1;
    ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
  } elsif ($is_xmudat) {
    $$prior_args{evkev}  = 'ev';
    $numerator{"$group.mu"} = 1;
    $energy = $group.".".$cols[0];
    ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy);
  };
				## try to guess if this is chi(k) data.
  if (($#cols == 3) and ($cols[1] eq 'chi')) {
    ($space, $space_label, $evkev) = ('c', 'chi.dat', 'ev');
  } elsif (($cols[0] eq 'k') or ($cols[1] =~ /chi/)) {
    ($space, $space_label, $evkev) = ('k', 'chi(K)', 'ev');
  } elsif ($is_xmudat) {
    ($space, $space_label, $evkev) = ('x', 'xmu.dat', 'ev');
  } elsif ($is_pixel) {
    ($space, $space_label, $evkev) = ('e', 'mu(E)', 'pixel');
    (($space, $space_label) = ('a','xanes(E)')) if $is_xanes;
  } else {
    (($space, $space_label) = ('a','xanes(E)')) if $is_xanes;
    my @cols = split(" ", $col_string);
    my @en = Ifeffit::get_array("$group.$cols[0]");
    ($#en > 0) || (@en = Ifeffit::get_array($group.'.1'));
    $evkev = ($en[0] < 100) ? 'kev' : 'ev';
  };
  $space       ||= 'm';		# fall back
  $space_label   = $label_map{$space};
  $evkev       ||= 'ev';

  ## Formulas
  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>0,)
    -> pack(-expand=>1, -fill=>'x');
  ## take the natural log?
  $fr -> Checkbutton(-text=>"Natural log",
		     -variable=>\$do_ln,
		     -selectcolor=>$red,
		     -onvalue=>1,
		     -command=>
		     sub{
		       $$prior_args{old}	 = $energy;
		       $$prior_args{numerator}   = \%numerator;
		       $$prior_args{denominator} = \%denominator;
		       $$prior_args{do_ln}	 = $do_ln;
		       $$prior_args{invert}	 = $invert;
		       $$prior_args{space}	 = $space;
		       $$prior_args{evkev}	 = $evkev;
		       $$prior_args{is_xmudat}   = $is_xmudat;
		       $$prior_args{sort}	 = $sort;
		       $$prior_args{multi}	 = $multi;
		       $$prior_args{ref}	 = \%reference;
		       ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
		     })
    -> pack(-side=>'left', -anchor=>'w');
  $widg{multi} = $fr -> Checkbutton(-text=>"Save each channel as a group",
				    -variable=>\$multi, -selectcolor=>$red,
				    -onvalue=>1, -offvalue=>0,
				    -state=>'disabled')
    -> pack(-side=>'right', -anchor=>'w');
  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>0,)
    -> pack(-pady=>2, -expand=>1, -fill=>'x');
  $fr -> Checkbutton(-text=>"Negate",
		     -variable=>\$invert,
		     -selectcolor=>$red,
		     -onvalue=>1,
		     -command=>
		     sub{
		       $$prior_args{old}	 = $energy;
		       $$prior_args{numerator}   = \%numerator;
		       $$prior_args{denominator} = \%denominator;
		       $$prior_args{do_ln}	 = $do_ln;
		       $$prior_args{invert}	 = $invert;
		       $$prior_args{space}	 = $space;
		       $$prior_args{evkev}	 = $evkev;
		       $$prior_args{is_xmudat}   = $is_xmudat;
		       $$prior_args{sort}	 = $sort;
		       $$prior_args{multi}	 = $multi;
		       $$prior_args{ref}	 = \%reference;
		       ($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
		     })
    -> pack(-side=>'left', -anchor=>'w');
  $fr -> Button(-text=>"Replot",
		-borderwidth=>1,
		-command=>sub{make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)},
	       )
    -> pack(-side=>'right', -anchor=>'w');

  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>0,)
    -> pack(-pady=>2, -expand=>1, -fill=>'x');
  $enlabel = $fr -> Label(-text=>"Energy:",
			  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left', -padx=>2);
  $enstr = $fr -> Label(-textvariable=>\$energy, -justify=>'left')
    -> pack(-side=>'left', -padx=>2, -expand=>1, -fill=>'x', -anchor=>'w');

  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-pady=>2, -expand=>1, -fill=>'x');
  $fnlabel = $fr -> Label(-text=>($is_xmudat) ? "theory:" : "mu(E):",
			  -foreground=>$config{colors}{activehighlightcolor},
			  -width=>6)
    -> pack(-side=>'left', -padx=>2);
  $mustr = $fr -> Scrolled("Entry", -text=>\$xmustring, -justify=>'left', -width=>35,
			   (($Tk::VERSION >= 804) ? (-disabledforeground=>$config{colors}{foreground}) : ()),
			   -state=>'disabled')
    -> pack(-side=>'left', -padx=>2, -expand=>1, -fill=>'x');
  $mustr->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					     ($is_windows) ? () : (-width=>8));

  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>2, -height=>2)
    -> pack(-pady=>2, -expand=>1, -fill=>'x');


  my $frm = $left -> Frame(-relief=>'flat', -borderwidth=>2)
    -> pack(-pady=>2, -expand=>1, -fill=>'x');
  ##  -> grid(-row=>5, -column=>0, -sticky=>'ew', -columnspan=>$#cols+2);
  ## choose the data type (mu || norm || chi || xmu.dat || chi.dat || detector)
  my $f1 = $frm -> Frame() -> pack(-side=>'top', -expand=>1, -fill=>'x');
  #my $f2 = $frm -> Frame() -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
  $f1 -> Label(-text=>'Data type: ', -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  my $om = $f1 -> Optionmenu(-font=>$config{fonts}{small},
			     -borderwidth=>1,
			     -textvariable=>\$space_label, -width=>7)
    -> pack(-side=>'left');
  $om ->command(-label=>'mu(E)',
		-command=>sub{$space='e'; $space_label='mu(E)';
			      $widg{evkev}->configure(-state=>'normal');
			      #$widg{pre}->configure(-state=>$preproc_state);
			      $enlabel -> configure(-text=>'Energy:');
			      $fnlabel -> configure(-text=>'mu(E):');
			      $unlabel -> configure(-foreground=>$active_color); });
  $om ->command(-label=>'norm(E)',
		-command=>sub{$space='n'; $space_label='norm(E)';
			      $widg{evkev}->configure(-state=>'normal');
			      #$widg{pre}->configure(-state=>$preproc_state);
			      $enlabel -> configure(-text=>'Energy:');
			      $fnlabel -> configure(-text=>'norm(E):');
			      $unlabel -> configure(-foreground=>$active_color); });
  $om ->command(-label=>'xanes(E)',
		-command=>sub{$space='a'; $space_label='xanes(E)';
			      $widg{evkev}->configure(-state=>'normal');
			      #$widg{pre}->configure(-state=>$preproc_state);
			      $enlabel -> configure(-text=>'Energy:');
			      $fnlabel -> configure(-text=>'mu(E):');
			      $unlabel -> configure(-foreground=>$active_color); });
  $om ->command(-label=>'chi(k)',
		-command=>sub{$space='k'; $space_label='chi(k)';
			      $widg{evkev}->configure(-state=>'disabled');
			      #$widg{pre}->configure(-state=>'disabled');
			      $enlabel -> configure(-text=>'wavenumber:');
			      $fnlabel -> configure(-text=>'chi(k):');
			      $unlabel -> configure(-foreground=>$grey); });
  $om ->command(-label=>'detector',
		-command=>sub{$space='d'; $space_label='detector';
			      $widg{evkev}->configure(-state=>'normal');
			      #$widg{pre}->configure(-state=>$preproc_state);
			      $enlabel -> configure(-text=>'Energy:');
			      $fnlabel -> configure(-text=>'det(E):');
			      $unlabel -> configure(-foreground=>$active_color);});
  $om ->command(-label=>'xmu.dat',
		-command=>sub{$space='x'; $space_label='xmu.dat';
			      $widg{evkev}->configure(-state=>'normal');
			      #$widg{pre}->configure(-state=>'disabled');
			      $enlabel -> configure(-text=>'Energy:');
			      $fnlabel -> configure(-text=>'theory:');
			      $unlabel -> configure(-foreground=>$active_color); });
  $om ->command(-label=>'chi.dat',
		-command=>sub{$space='c'; $space_label='chi.dat';
			      $widg{evkev}->configure(-state=>'disabled');
			      #$widg{pre}->configure(-state=>'disabled');
			      $enlabel -> configure(-text=>'wavenumber:');
			      $fnlabel -> configure(-text=>'theory:');
			      $unlabel -> configure(-foreground=>$grey); });

  $f1 -> Frame(-width=>10)
    -> pack(-side=>'left');
  $unlabel = $f1 -> Label(-text=>'Energy units: ',
			  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  $widg{evkev} = $f1 -> Optionmenu(-font=>$config{fonts}{small},
				   -borderwidth=>1,
				   -textvariable=>\$evkev, -width=>6)
    -> pack(-side=>'left');
  $widg{evkev} -> command(-label  =>'eV',
			  -command=>sub{$evkev = 'ev';
					#$widg{extras} -> raise(($preproc_number>1) ? 'preprocessing' : 'reference');
					$$prior_args{old}	     = $energy;
					$$prior_args{numerator}   = \%numerator;
					$$prior_args{denominator} = \%denominator;
					$$prior_args{do_ln}	     = $do_ln;
					$$prior_args{invert}	     = $invert;
					$$prior_args{space}	     = $space;
					$$prior_args{evkev}	     = $evkev;
					$$prior_args{is_xmudat}   = $is_xmudat;
					$$prior_args{sort}	     = $sort;
					$$prior_args{multi}	     = $multi;
					$$prior_args{ref}	     = \%reference;
					($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
				      });
  $widg{evkev} -> command(-label  =>'keV',
			  -command=>sub{$evkev = 'kev';
					#$widg{extras} -> raise(($preproc_number>1) ? 'preprocessing' : 'reference');
					$$prior_args{old}	     = $energy;
					$$prior_args{numerator}   = \%numerator;
					$$prior_args{denominator} = \%denominator;
					$$prior_args{do_ln}	     = $do_ln;
					$$prior_args{invert}	     = $invert;
					$$prior_args{space}	     = $space;
					$$prior_args{evkev}	     = $evkev;
					$$prior_args{is_xmudat}   = $is_xmudat;
					$$prior_args{sort}	     = $sort;
					$$prior_args{multi}	     = $multi;
					$$prior_args{ref}	     = \%reference;
					($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
				      });
  $widg{evkev} -> command(-label  =>'pixel',
			  -command=>sub{$evkev = 'pixel';
					#$widg{extras} -> raise(($preproc_number>1) ? 'preprocessing' : 'reference');
					$$prior_args{old}	     = $energy;
					$$prior_args{numerator}   = \%numerator;
					$$prior_args{denominator} = \%denominator;
					$$prior_args{do_ln}	     = $do_ln;
					$$prior_args{invert}	     = $invert;
					$$prior_args{space}	     = $space;
					$$prior_args{evkev}	     = $evkev;
					$$prior_args{is_xmudat}   = $is_xmudat;
					$$prior_args{sort}	     = $sort;
					$$prior_args{multi}	     = $multi;
					$$prior_args{ref}	     = \%reference;
					($xmustring, @toss) = make_xmu_string(\%numerator, \%denominator, $do_ln, $invert, $energy)
				      },
			  -state=>($config{pixel}{do_pixel_check}) ? 'normal' : 'disabled');
  if ($space =~ /[ck]/) {
    $widg{evkev}->configure(-state=>'disabled');
    $enlabel -> configure(-text=>'wavenumber:');
    $unlabel -> configure(-foreground=>$grey);
  };
 FN: {
    $fnlabel -> configure(-text=>'mu(E):'),   last FN if ($space eq 'e');
    $fnlabel -> configure(-text=>'norm(E):'), last FN if ($space eq 'n');
    $fnlabel -> configure(-text=>'mu(E):'),   last FN if ($space eq 'a');
    $fnlabel -> configure(-text=>'chi(k):'),  last FN if ($space eq 'k');
    $fnlabel -> configure(-text=>'det(E):'),  last FN if ($space eq 'd');
    $fnlabel -> configure(-text=>'theory:'),  last FN if ($space eq 'x');
    $fnlabel -> configure(-text=>'theory:'),  last FN if ($space eq 'c');
  };




  $preprocess{raised} ||= "reference";
  $widg{extras} = $left -> NoteBook(-background=>$config{colors}{background},
				    -backpagecolor=>$config{colors}{background},
				    -inactivebackground=>$config{colors}{inactivebackground},
				    -font=>$config{fonts}{small},
				   )
     -> pack(-pady=>2, -expand=>1, -fill=>'x');
  $widg{pre_card} = $widg{extras} ->
    add("preprocessing", -label=>'Preprocess', -anchor=>'center',
	-state=>$preproc_state);
  set_preprocessing(\%widg)
    -> pack(-expand=>1, -fill=>'x');
  $widg{bin_card} = $widg{extras} ->
    add("bin",           -label=>'Bin'     ,     -anchor=>'center',
	-state=>($$prior_args{space} eq 'k') ? 'disabled' : 'normal');
  set_bin(\%widg)
    -> pack(-anchor=>'n', -fill=>'x');
  $widg{ref_card} = $widg{extras} ->
    add("reference",     -label=>'Reference',     -anchor=>'center',);
  set_reference($widg{ref_card}, $group, \@cols, \%widg, \%reference, \$energy)
    -> pack(-anchor=>'n', -fill=>'x');
  ## $widg{fav_card} = $widg{extras}
  ##   -> add("favorites",     -label=>'Favorites',   -anchor=>'center',);
  ## set_favorites(\%widg)
  ##   -> pack(-anchor=>'n', -fill=>'x');
  $widg{extras} -> raise($preprocess{raised});

  $$prior_args{extra_shown} = 1; # 0;
##   $widg{extra_button} = $left -> Button(-text=>'Show extra features', @button_list,
## 					-command=>
## 					sub{
## 					  my ($h,$w) = ($left->height(), $raw->width());
## 					  $reference{preproc_state} = $preproc_state;
## 					  $widg{extra_button} -> packForget;
## 					  $top -> update; # needed so $raw resizes correctly
## 					  $widg{extras} -> pack(-pady=>2, -expand=>1, -fill=>'x');
## 					  $right->pack(-expand=>1, -fill=>'both',
## 						       -side=>'right', -anchor=>'n');
## 					  $databox->pack(-expand=>1, -fill=>'both',
## 							 -padx=>4, -pady=>2);
## 					  $widg{extras} -> raise(($preproc_number>1 eq 'normal') ? 'preprocessing' : 'reference');
## 					  $$prior_args{extra_shown} = 1;
## 					})
##     -> pack(-expand=>1, -fill=>'x', -pady=>0);


  ## help button
  #$left -> Button(-text=>'Document section: importing data', @button_list,
  #		  -command=>sub{pod_display("import::index.pod")})
  #  -> pack(-side=>'bottom', -fill=>'x', -pady=>2);

  $fr = $left -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-pady=>2, -expand=>1, -fill=>'x', -side=>'bottom');
  $widg{ok}= $fr -> Button(-text=>'OK', @button_list,
			   -command=>
			   sub {
			     $widg{ok} -> configure(-state=>'disabled');
			     if (($rebin{do_rebin}) and ($rebin{abs} =~ /^\s*$/)) {
			       my $dialog =
				 $raw -> Dialog(-bitmap         => 'error',
						-text           => "You did not specify an absorber.  The on-the-fly rebinning algorithm needs to know the absorber species.",
						-title          => 'Athena: Problem with rebinning parameters',
						-buttons        => ['Go back', 'Import without rebinning'],
						-default_button => 'Go back',
						-popover        => 'cursor');
			       $dialog->raise;
			       my $response = $dialog->Show();
			       if ($response eq 'Go back') {
				 $widg{ok} -> configure(-state=>'normal');
				 $raw->raise;
				 $widg{extras} -> raise("bin");
				 $widget{rebin_abs} -> focus;
				 return (-1, $prior_string);
			       };
			     };
			     if (($rebin{do_rebin}) and (lc($rebin{abs}) !~ /^$Ifeffit::Files::elem_regex$/)) {
			       my $dialog =
				 $raw -> Dialog(-bitmap         => 'error',
						-text           => "Your absorber, $rebin{abs}, is not a valid element symbol.  The on-the-fly rebinning cannot continue.",
						-title          => 'Athena: Problem with rebinning parameters',
						-buttons        => ['Go back', 'Import without rebinning'],
						-default_button => 'Go back',
						-popover        => 'cursor');
			       my $response = $dialog->Show();
			       if ($response eq 'Go back') {
				 $widg{ok} -> configure(-state=>'normal');
				 $raw->raise;
				 $widget{rebin_abs} -> focus;
				 return (-1, $prior_string);
			       };
			     };
			     $preprocess{raised} = $widg{extras}->raised();
			     $colsel_geometry = $raw->geometry;
			     $$prior_args{old}	       = $energy;
			     $$prior_args{numerator}   = \%numerator;
			     $$prior_args{denominator} = \%denominator;
			     $$prior_args{do_ln}       = $do_ln;
			     $$prior_args{invert}      = $invert;
			     $$prior_args{space}       = $space;
			     $$prior_args{evkev}       = $evkev;
			     $$prior_args{is_xmudat}   = $is_xmudat;
			     $$prior_args{sort}	       = $sort;
			     $$prior_args{multi}       = $multi;
			     my $ret = &construct_xmu($raw, $group, $label,
						      $data, $stash, $prior_args
						     );
			     $$prior_args{ref}	       = \%reference;
			     if ($ret < 0) {$$r_cancel = 1; $raw->destroy;
					    return (-1, $col_string)};
			     $widg{ok} -> configure(-state=>'normal') if ($ret == 0);
			   })
    -> pack(-expand=>1, -fill=>'x', -pady=>2, -side=>'left');
  $fr -> Button(-text=>'Cancel', @button_list,
		-command=>sub{$colsel_geometry = $raw->geometry;
			      $$r_cancel = 1; $raw->destroy; return (-1, $prior_string)})
    -> pack(-expand=>1, -fill=>'x', -pady=>2, -side=>'right');


  ## setup the display of the data file text
  my $h = $left->height();
  $databox = $right -> Scrolled(qw/ROText -relief sunken -borderwidth 2
				-wrap none -scrollbars se -width 50/,
				-font=>$config{fonts}{fixed})
    -> pack(-expand=>1, -fill=>'both', -padx=>4, -pady=>2);
  $databox -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
  $widg{databox} = $databox;
  BindMouseWheel($databox);
  $databox->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
  $databox->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
  my $to_display = ($is_binary) ? $stash : $data;
  open F, $to_display or die "Could not open $to_display\n";
  while (<F>) {
    s/\r//;
    $databox -> insert('end', $_, 'text');
  };
  close F;
  ## display the multi-element button properly
  my $sum;
  foreach my $v (values %numerator) {$sum += $v};
  $widg{multi} -> configure(-state=>($sum > 1)?'normal':'disabled');


  ## show the reference dialog if the reference channels are set, which only
  ## happens if this is similar to the prior data and the prior had reference
  ## channels
  ## print Data::Dumper->Dump([\%reference], [qw(*reference)]);
  if ($reference{numerator} or $reference{denominator}) {
    $reference{preproc_state} = $preproc_state;
    ##$widg{extra_button} -> packForget;
    $top -> update; # needed so $raw resizes correctly
    $widg{extras} -> pack(-pady=>2, -expand=>1, -fill=>'x');
    $right->pack(-expand=>1, -fill=>'both', -side=>'right', -anchor=>'n');
    $databox->pack(-expand=>1, -fill=>'both', -padx=>4, -pady=>2);
    #$widg{extras} -> raise('reference');
    $$prior_args{extra_shown} = 1;
  };

  $widg{ok} -> focus;
  ##$raw -> raise;
  $raw -> grab;
  ##$top -> update;
  ##$update -> grabRelease;
  $$prior_args{old}	     = $energy;
  $$prior_args{numerator}    = \%numerator;
  $$prior_args{denominator}  = \%denominator;
  $$prior_args{do_ln}	     = $do_ln;
  $$prior_args{invert}	     = $invert;
  $$prior_args{space}	     = $space;
  $$prior_args{evkev}	     = $evkev;
  $$prior_args{is_xmudat}    = $is_xmudat;
  $$prior_args{sort}	     = $sort;
  $$prior_args{multi}	     = $multi;
  $$prior_args{ref}	     = \%reference;
  return ($raw, $col_string);
};


sub column_string {
  my $col_string = q{};
  my $i = 1;
  my $this = Ifeffit::get_string('$column_label'.$i);
  while ($this !~ m{^\s*$}) {
    $col_string .= $this . ' ';
    ++$i;
    $this = Ifeffit::get_string('$column_label'.$i)
  };
  # $col_string =~ s{^nergy}{energy}i;
  return $col_string;
};

## this suppresses a nattering message that warns, in cryptic fashion,
## when you attempt to read a non-zip file as a zip file.  since that
## is the only way to test for zippiness of a file using Archive::Zip,
## simply suppressing the message seems appropriate.
sub is_zip_error_handler { 1; };



## $w takes the column selection Toplevel or 0 if this is a repeated file
sub construct_xmu {
  my ($w, $group, $label, $file, $stash, $prior_args) = @_;
    #$en, $rn, $rd, $ln, $inv, $space, $evkev, $is_xmudat, $sort, $multi, $reference, $sorted) = @_;
  #print join(" ", $group, $file, $en, $rn, $rd, $ln, $space, $evkev,
  #	     $is_xmudat, $sort, $multi), $/;

  my $en	 = $$prior_args{old};	       # 0
  my $rn	 = $$prior_args{numerator};    # 1
  my $rd	 = $$prior_args{denominator};  # 2
  my $ln	 = $$prior_args{do_ln};	       # 3
  my $inv	 = $$prior_args{invert};       # 4
  my $space	 = $$prior_args{space};	       # 5
  my $evkev	 = $$prior_args{evkev};	       # 6
  my $is_xmudat	 = $$prior_args{is_xmudat};    # 7
  my $sort	 = $$prior_args{sort};	       # 8
  my $multi	 = $$prior_args{multi};	       # 9
  my $reference	 = $$prior_args{ref};	       # 10
  my $sorted	 = $$prior_args{sorted};       # 11

  #print join(" ", %$reference), $/;
  unless (($group) and ($en) and ($rd) and ($rn)) {
    ($w == 0) or $w -> destroy();	# get rid of column palette
    Echo("Group undefined!"),            return 0 unless $group;
    Echo("Energy array undefined!"),     return 0 unless $en;
    Echo("Numerator hash undefined!"),   return 0 unless $rn;
    Echo("Denominator hash undefined!"), return 0 unless $rd;
  };
  ## must take care when reading multiple files that the arguments
  ## from the previous run have the current group name substituted
  ## in. The following regex is unnecessary (but not incorrect) when
  ## reading a single data file, but is essential when reading a set
  ## of data files
  ##
  ## The regex is anything that is not an alphanumeric, an underscore,
  ## or a question mark then followed by a dot, but the dot is matched
  ## by a non-consuming look-ahead, so it does not get substituted
  ##
  ## Matt sez (mail 17 Jan. 2003) "the first character for scalars and
  ## group prefix must be 'a-z_&', and 'a-z0-9_&' for group suffixes,
  ## and that subsequent characters can be any of 'a-z0-9_&:?@~' ".  I
  ## am actually only using _ and ? as nonalphanumerics
  $en =~ s/[A-Za-z0-9_?]+(?=\.)/$group/g;
  $space = lc($space);
  $evkev = lc($evkev);
  ($evkev =~ /(kev|pixel)/) or ($evkev = 'ev');
  ($is_xmudat)     and ($space = 'e');  # n for normalizaed
  ($space eq 'c')  and ($space = 'k');
  ($space eq 'k')  and ($evkev = '');
  #$prior_args = [$en, $rn, $rd, $ln, $inv, $space, $evkev, $is_xmudat, $sort, $multi, $reference, $sorted];
  ($w == 0) or $w -> grabRelease; # column palette gives up grab
  ($label .= "_pixel") if ($evkev eq 'pixel');


  my ($str, $num, $den, $i0) =  make_xmu_string($rn, $rd, $ln, $inv, 0);
  if (($str eq "1") or ($str eq "ln(abs(1))")) {
    my $message = "You have not selected any data columns!";
    my $dialog =
      $w -> Dialog(-bitmap         => 'questhead',
		   -text           => $message,
		   -title          => 'Athena: oops!',
		   -buttons        => [qw/OK/],
		   -default_button => 'OK');
    my $response = $dialog->Show();
    #$w -> raise();
    $top -> update;
    return 0;
  };

  unless ($num) {
    #($w == 0) or $w -> destroy();	# get rid of column palette
    Echo("Data string was not selected.") and return 0;
  };
  ## clean up the strings to use  the current group's group name
  $str =~ s/[A-Za-z0-9_?]+(?=\.)/$group/g; # same regex as above
  $num =~ s/[A-Za-z0-9_?]+(?=\.)/$group/g;
  $den =~ s/[A-Za-z0-9_?]+(?=\.)/$group/g;
  $i0  =~ s/[A-Za-z0-9_?]+(?=\.)/$group/g;
  my $was_backwards = 0;	            # Ifeffit::Files->backwards_data($group, $en);
  my ($isnt_monotonic, @points)  = Ifeffit::Files->monotonic_data($group, $en, $evkev); # (0, ());
  if ($isnt_monotonic) {
    my $xaxis = "energy";
    ($space eq 'k') and ($xaxis = "wavenumber");
    my $response = "";
#     if ($sorted) {
#       $response = $sorted;
#     } else {
#       my $message = "This file:\n\n  $file\n\n";
#       $message   .= "contains data that are not monotonically increasing in $xaxis.\n";
#       if ($#points) {
# 	$message   .= "(check data points " . join(", ", @points) . ")";
#       } else {
# 	$message   .= "(check data point $points[0])";
#       };
#       $message   .= "\n\n\nAthena cannot import data in this state.";
#       $message   .= " You may sort these data by $xaxis,";
#       $message   .= " discarding repeated points,";
#       $message   .= " or you may simply cancel the import of these data.";
#       my $dialog =
# 	$top -> Dialog(-bitmap         => 'warning',
# 		       -text           => $message,
# 		       -title          => 'Athena: Non-monotonic data file',
# 		       -buttons        => ['Sort data', 'Cancel'],
# 		       -default_button => 'Sort data');
#       ($w == 0) or $w -> lower; # the dialog sometimes is hard to see on the screen!
#       $response = $dialog->Show(-popover    => 'cursor'  );
#     };
    $response = "Sort data";
    if ($response eq 'Cancel') { # discard non-monotonic data
      #($w == 0) or $w -> destroy();	# get rid of column palette
      $setup -> dispose("erase \@group $group");
      Echo("Canceling import of \"$file\"");
      return -1;
    } else {			# fix non-monotonic data
      $$prior_args{sorted} = $response;
      Echo("Sorting data for $label");

      ## This block is a complicated bit.  The idea is to store all
      ## the data in a list of lists.  In this way, I can sort all the
      ## data in one swoop by sorting off the energy part of the list
      ## of lists.  After sorting, I check the data for repeated
      ## points and remove them.  Finally, I reload the data into
      ## ifeffit and carry on like normal data

      ## This gets a list of column labels
      my @cols = split(" ", &column_string);
      my @lol;
      ## energy value is zeroth in each anon list
      my @array = get_array("$en");
      map {push @{$lol[$_]}, $array[$_]} (0 .. $#array);
      foreach my $c (@cols) {
	## load other cols (including energy col) into anon. lists
	my @array = get_array("$group.$c");
	map {push @{$lol[$_]}, $array[$_]} (0 .. $#array);
      };
      ## sort the anon. lists by energy (i.e. zeroth element)
      @lol = sort {$a->[0] <=> $b->[0]} @lol;

      ## now fish thru lol looking for repeated energy points
      my $ii = 0;
      while ($ii < $#lol) {
	($lol[$ii+1]->[0] > $lol[$ii]->[0]) ? ++$ii : splice(@lol, $ii+1, 1);
      };

      ## now feed columns back to ifeffit
      foreach my $c (0 .. $#cols) {
	my @array;
	map {push @array, $_->[$c+1]} @lol;
	$setup->dispose("erase $group.$cols[$c]", $dmode);
	Ifeffit::put_array("$group.$cols[$c]", \@array);
      };
      $setup->dispose("## Athena reloaded arrays after sorting non-monotonic data\n", $dmode);
    };
  };
  ## for multi-element data fed to separate groups -- loop over
  ## channels.  For all other data, this is a "loop" over a list 1
  ## item long
  my @channel_list = ($num);
  if ($multi) {
    (my $channels = $num) =~ s/[()]//g;
    @channel_list = split(/\s*\+\s*/, $channels);
  };
  foreach my $c (@channel_list) {
    my $this_str = $str;
    my $grp = $group;
    if ($multi) {
      my $suff = (split(/\./, $c))[1];
      ($grp, $label) = group_name(basename($file) . "_" . $suff);
      ($this_str, my $num, my $den, my $i0) =  make_xmu_string({$c => 1}, $rd, $ln, $inv, 0);
    }

    ++$line_count;
    $i0 =~ s/[\(\)]//g;
    $groups{$grp} = Ifeffit::Group -> new(group=>$grp, label=>$label,
					  is_rsp=>0, is_qsp=>0, line=>$line_count,
					  is_rec=>0, file=>$file, en_str=>$en, mu_str=>$this_str,
					  is_raw=>1, numerator=>$c, denominator=>$den,
					  i0=>$i0);

    $groups{$grp} -> dispose("\n## Importing a new file\n");
    if ($sort_available) {
      if ($isnt_monotonic and (not $is_xmudat)) {
	$groups{$grp} ->
	  dispose("## uncomment the following line in a macro to have ifeffit sort the data\n", $dmode);
	$groups{$grp} ->
	  dispose("## read_data(file=\"$stash\", group=$grp, sort=$sort)\n", $dmode);
      };
    };

    if ($space =~ /[enx]/) {
      $groups{$grp} -> make(is_xmu=>1, is_chi=>0, is_xmudat=>$is_xmudat);
      ($space =~ /[nx]/) and ($groups{$grp} -> make(is_nor=>1));
      if ($evkev eq 'ev') {
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } elsif ($evkev eq 'pixel') {
	$groups{$grp} -> make(is_pixel=>1);
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } else {			# keV
	$groups{$grp} -> dispose("set $grp.energy = 1000*$en\n", $dmode);
      };
      $rebin{do_rebin} and perform_rebinning($grp);
      if (length($this_str) < 251) {
	$groups{$grp} -> dispose("set $grp.xmu = $this_str\n", $dmode);
      } else {
	&long_string($grp, "$grp.xmu", $this_str);
      };
    } elsif ($space =~ /[ck]/) {
      $groups{$grp} -> make(is_xmu=>0, is_chi=>1);
      $groups{$grp} -> dispose("set $grp.k = $en\n", $dmode);
      $groups{$grp} -> dispose("set $grp.chi = $this_str\n", $dmode);
      if (($space eq 'k') and (not Ifeffit::Files->uniform_k_grid($grp))) {
	$setup->dispose("## this seems to be chi(k) data in need of fixing...\nfix_chik($grp)",
			$dmode);
      };
    } elsif ($space eq 'd') {
      $groups{$grp} -> make(not_data=>1, is_xmu=>0, is_chi=>0, is_rsp=>0, is_qsp=>0);
      if ($evkev eq 'ev') {
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } elsif ($evkev eq 'pixel') {
	$groups{$grp} -> make(is_pixel=>1);
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } else {
	$groups{$grp} -> dispose("set $grp.energy = 1000*$en\n", $dmode);
      };
      $rebin{do_rebin} and perform_rebinning($grp);
      if (length($this_str) < 251) {
	$groups{$grp} -> dispose("set $grp.det = $this_str\n", $dmode);
      } else {
	&long_string($grp, "$grp.det", $this_str);
      };
    } elsif ($space eq 'a') {
      $groups{$grp} -> make(not_data=>0, is_xmu=>1, is_xanes=>1,
			    is_chi=>0, is_rsp=>0, is_qsp=>0, bkg_nnorm=>2);
      if ($evkev eq 'ev') {
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } elsif ($evkev eq 'pixel') {
	$groups{$grp} -> make(is_pixel=>1);
	$groups{$grp} -> dispose("set $grp.energy = $en\n", $dmode);
      } else {
	$groups{$grp} -> dispose("set $grp.energy = 1000*$en\n", $dmode);
      };
      $rebin{do_rebin} and perform_rebinning($grp);
      if (length($this_str) < 251) {
	$groups{$grp} -> dispose("set $grp.xmu = $this_str\n", $dmode);
      } else {
	&long_string($grp, "$grp.xmu", $this_str);
      };
    };

    set_defaults($grp, $space, $is_xmudat);
    $preprocess{evkev} = $evkev;
    $preprocess{ok}  and perform_preprocessing($grp);

    fill_skinny($list, $grp, 1);
    if ($$reference{numerator} or $$reference{denominator}) {
      Echo("Importing reference channel for $label ...");
      my ($ref, $ref_label) = group_name("   Ref " . $label);
      $groups{$grp} -> make(reference=>$ref);
      ++$line_count;
      $$reference{numerator}   ||= 1;
      $$reference{denominator} ||= 1;
      $this_str = join("/", $$reference{numerator}, $$reference{denominator});
      ($this_str = "ln(abs($this_str))") if $$reference{ln};
      $this_str =~ s/[A-Za-z0-9_?]+(?=\.)/$grp/g; # same regex as above
      $groups{$ref} = Ifeffit::Group -> new(group	=> $ref,
					    label	=> $ref_label,
					    is_xmu	=> 1,
					    is_chi	=> 0,
					    is_nor	=> 0,
					    is_rsp	=> 0,
					    is_qsp	=> 0,
					    is_rec	=> 0,
					    is_raw	=> 1,
					    en_str	=> $en,
					    mu_str	=> $this_str,
					    numerator	=> $$reference{numerator},
					    denominator	=> $$reference{denominator},
					    reference	=> $grp,
					    is_ref      => 1,
					    bkg_eshift	=> $groups{$grp}->{bkg_eshift});
      $groups{$ref} -> make(bkg_eshift=>0) unless ($groups{$ref}->{bkg_eshift} =~ /-?(\d+\.?\d*|\.\d+)/);
      $groups{$ref} -> make(line => $line_count,
			    file => "reference channel for " . $groups{$grp}->{label});
      $groups{$ref} -> set_to_another($groups{$grp});

      if ($$reference{same}) {
	$groups{$grp} -> make(refsame=>1);
	$groups{$ref} -> make(bkg_z=>$groups{$grp}->{bkg_z},
			      fft_edge=>$groups{$grp}->{fft_edge},
			      refsame=>1,
			     );
      };
      $groups{$ref} -> dispose("set $ref.energy = $grp.energy\n", $dmode);
      $groups{$ref} -> dispose("set $ref.xmu = $this_str\n", $dmode);
      $groups{$ref} -> dispose("pre_edge($ref.energy, $ref.xmu)\n", $dmode);
      $groups{$ref} -> make(bkg_e0   => Ifeffit::get_scalar("e0"),
			    is_xanes => $groups{$grp}->{is_xanes});
      if (not $$reference{same}) {
	$groups{$grp} -> make(refsame=>0);
	my ($z, $edge) = find_edge($groups{$ref}->{bkg_e0});
	$groups{$ref} -> make(bkg_z=>$z,
			      fft_edge=>$edge,
			      refsame=>0,
			     );
      };
      fill_skinny($list, $ref, 1);
      Echo("Importing reference channel for $label ... done!");
    };
    clean_unused_columns($grp, $en, $num, $den);

    my $stan = $preprocess{standard};
    if ($preprocess{al_do} and ($stan !~ /None/) and exists($groups{$stan})) {
      my $eshift;
      if ($groups{$stan}->{reference} and $groups{$grp}->{reference}) {
	$groups{$grp} -> dispose("## Aligning $groups{$grp}->{label} using reference", $dmode);
	Echo("Aligning $groups{$grp}->{label} using reference");
	$eshift = auto_align($groups{$stan}->{reference}, $groups{$grp}->{reference}, 'd');
      } else {
	$groups{$grp} -> dispose("## Aligning $groups{$grp}->{label} using data", $dmode);
	Echo("Aligning $groups{$grp}->{label} using data", 0);
	$eshift = auto_align($stan, $grp, 'd');
      };
      $groups{$grp} -> dispose("## need to re-get e0 after doing the preprocessing auto-alignment...\npre_edge(\"$grp.energy+$eshift\", $grp.xmu)\n", $dmode);
      $groups{$grp} -> make(bkg_e0 => Ifeffit::get_scalar("e0")) unless $preprocess{par_do};
      $groups{$grp} -> make(bkg_eshift => $eshift);
      my $ref = $groups{$grp}->{reference};
      if ($ref) {
	$groups{$ref} -> make(bkg_eshift => $eshift);
	$groups{$ref} -> dispose("pre_edge($ref.energy, $ref.xmu)\n", $dmode);
	$groups{$ref} -> make(bkg_e0   => Ifeffit::get_scalar("e0"));
      };
      push @{$preprocess{titles}}, "^^    alignment to $groups{$stan}->{label}";
    };

    ## marking proprocessing
    Echo("Marking $groups{$grp}->{label}", 0);
    ($marked{$grp} = 1) if $preprocess{mark_do};

    ## capture title lines from the data file and from the extra import features
    $groups{$grp} -> get_titles;
    foreach (@{$rebin{titles}}) {
      push @{$groups{$grp}->{titles}}, $_;
    };
    foreach (@{$preprocess{titles}}) {
      push @{$groups{$grp}->{titles}}, $_;
    };
    push @{$groups{$grp}->{titles}}, "^^ Imported with reference channel"
      if ($$reference{numerator} or $$reference{denominator});

    my @titles = ();
    foreach (@{$groups{$grp}->{titles}}) {
      next if ($_ =~ /^\s*$/);
      my $str = (length($_) > 254) ? substr($_, 0, 254) : $_;
      my $count = 0;
      foreach my $i (0..length($str)) {
	++$count if (substr($str, $i, 1) eq '(');
	--$count if ($count and (substr($str, $i, 1) eq ')'));
      };
      ## close all unmatched parens by appending close_parens to the string
      $str .= ')' x $count;
      ## ! % and # in title lines seem to be a problem on Windows
      $str =~ s/[!\%\#]//g;
      push @titles, $str;
    };
    $groups{$grp} -> make(titles=>\@titles);
    $groups{$grp} -> put_titles;

    ## and show some eye candy...
    set_properties(1, $grp,0);
    unless ($w == 0) {
      &set_key_params;
    SWITCH: {
	$groups{$grp} -> plotE('em',  $dmode,\%plot_features, \@indicator), last SWITCH if ($is_xmudat);
	$groups{$grp} -> plotE('em',  $dmode,\%plot_features, \@indicator), last SWITCH if ($space eq 'd');
	$groups{$grp} -> plotE('em',  $dmode,\%plot_features, \@indicator), last SWITCH if ($space eq 'a');
	$groups{$grp} -> plotE('emz', $dmode,\%plot_features, \@indicator), last SWITCH if ($space eq 'e');
	$groups{$grp} -> plotE('emzn',$dmode,\%plot_features, \@indicator), last SWITCH if ($space eq 'n');
	$groups{$grp} -> plotk('k1',  $dmode,\%plot_features, \@indicator), last SWITCH if ($space eq 'k');
      };
      $last_plot = $space;
      ($last_plot = 'e') if (($space eq 'a') or ($space eq 'n'));
      $plotsel->raise($last_plot) unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      my $pl_str = 'emz';
      if ($space =~ /k/) {
	$pointfinder{space} -> configure(-text=>"The last plot was in k");
      } else {
	$pointfinder{space} -> configure(-text=>"The last plot was in Energy");
      };
      foreach (qw(x xpluck xfind y ypluck clear)) {
	$pointfinder{$_} -> configure(-state=>'normal');
      };
      ($space eq 'k') and ($pl_str = 'k1');
      ($space eq 'n') and ($pl_str = 'emzn');
      ($is_xmudat)    and ($pl_str = 'em');
      $last_plot_params = [$grp, 'group', $space, $pl_str];
      ## this seems to be necessary...
      ($is_xmudat)    and $groups{$grp}->make(update_bkg=>1);
    }; # end of plotting SWITCH
    unless ($config{fft}{kmax}){
      $groups{$grp} -> dispose("___x = ceil($groups{$grp}->{group}.k)\n", 1);
      $groups{$grp} -> make(fft_kmax=>Ifeffit::get_scalar("___x"));
      $groups{$grp} -> kmax_suggest(\%plot_features);
    };

  }; # end of loop over data channels
  ($w == 0) or $w -> destroy();	# get rid of column palette

  $was_backwards and
    Echo("Notice: Athena had to reverse the data in this file as it was in descending order");
  return 1;
};

## construct the string that tells ifeffit how to make mu(E) out of
## columns of data
sub make_xmu_string {
  my ($rn, $rd, $ln, $inv, $en) = @_;
  my $num = "(";                               # build the numerator string:
  map {$$rn{$_} and ($num .= $_ . " + ")} (sort keys %$rn);
  $num = substr($num, 0, -3) . ")";
  ($num eq ')') and ($num = "1");
  my $str = $num;
  my $den = "(";			       # build the denominator string:
  map {$$rd{$_} and ($den .= $_ . " + ")} (sort keys %$rd);
  $den = substr($den, 0, -3) . ")";
  ($den eq ')') and ($den = "");
  ($den) and $str .= " / " . $den;
  ($ln) and ($str = "ln(abs(" . $str . "))");  # transmission data
  ($inv) and ($str = "-1*" . $str);	       # invert

  ## autoplot as columns are selected
  if ($en and $config{general}{autoplot}) {
    &set_key_params;
    my $command = "\n## Autoplot in the file selection dialog:\n";
    $command   .= "set t___oss.y = $str\n";
    $command   .= "newplot(x=$en, y=t___oss.y, ";
    $command   .= "color=$config{plot}{c0}, title=\"current column selection\", xlabel=x, ylabel=y)\n";
    $command   .= "erase \@group t___oss\n";
    $groups{"Default Parameters"}->dispose($command, $dmode);
  };
  my $i0 = ($ln) ? $num : $den;
  ($i0 = "") unless $den;

  ## return full string, numerator part, denominator part
  return ($str, $num, $den, $i0);
};


## deal with a very long string as the expression for setting a vector
## assume it is of the form (a + b + c + ...) / i0
sub long_string {
  my ($g, $xmu, $string) = @_;
  my ($num, $den) = split(/\s*\/\s*/, $string);
  $num =~ s/[()]//g;
  my @channels = split(/\s*\+\s*/, $num);
  $groups{$g} -> dispose("set ___npts = npts($g.energy)", $dmode);
  $groups{$g} -> dispose("set $xmu = zeros(___npts)", $dmode);
  foreach my $ch (@channels) {
    $groups{$g} -> dispose("set $xmu = $xmu + $ch/$den", $dmode);
  };
};

sub clean_unused_columns {
  my ($group, $en, $num, $den) = @_;
  my @col_string = split(" ", &column_string);
  my @words = split(/[() \t+]+/, $num);
  push @words, split(/[() \t+]+/, $den);
  if ($groups{$group}->{reference}) {
    my $str = $groups{$groups{$group}->{reference}}->{numerator};
    push @words, split(/[() \t+]+/, $str);
    $str = $groups{$groups{$group}->{reference}}->{denominator};
    push @words, split(/[() \t+]+/, $str);
  };
  my @used = ((split(/\./,$en))[1]); # put energy suffix in the list
  foreach my $w (@words) {	     # of used columns
    next if ($w =~ /^\s*$/);
    push @used, (split(/\./, $w))[1]; # put suffixes used in numerator
  };				      # and denominator in list
  ## see Perl Cookbook recipe 4.7 p. 104
  my %seen;          # lookup table
  my @csonly;        # only in @col_string
  @seen{@used} = (); # perl-y magic!
  foreach my $i (@col_string) {
    push(@csonly, $i) unless exists $seen{$i};
  };
  ## print "col_string: ", join(" ", @col_string), $/;
  ## print "used: ", join(" ", @used), $/;
  ## print "unused: ", join(" ", @csonly), $/;
  foreach my $suff (@csonly) {	# erase the unused columns
    $groups{$group} -> dispose("erase $group.$suff", $dmode);
  };
};


## open a Toplevel with a palette for setting preprocessing
## parameters, including parameters for deglitching, truncating,
## interpolating, and aligning data sets as they are read in.  A
## standard, i.e. a record already read in, must be chosen for all
## these actions.
sub set_preprocessing {
  my $widg = $_[0];
  my $ppp = $$widg{pre_card};
  my $parent = $ppp -> Frame(-borderwidth=>0, -relief=>'flat');
  my $how_many = scalar(keys %groups);

  ## set some variables
  my $red = $config{colors}{single};
  my $blue= $config{colors}{activehighlightcolor};
  my $grey= '#9c9583';
  #my $pre = $top->Toplevel(-class=>'horae');
  #$pre -> title('Athena: preprocess data');
  my (%widgets, %labels, %grab);

  $parent -> Label(-text=>'Preprocessing parameters',
		   -font=>$config{fonts}{bold},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-pady=>3);
  ## choose a standard
  my $frame = $parent -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');

  my $exists = 0;
  foreach my $k (&sorted_group_list) { $exists = 1, last if ($k eq $preprocess{standard}); };
  $exists or (($preprocess{standard},$preprocess{standard_lab})  = ('None','0: None'));
  $preprocess{ok} = ($preprocess{standard} eq 'None') ? 0 : 1;
  my $initial_state = ($preprocess{standard} eq 'None') ? 'disabled' : 'normal';
  $frame -> Label(-text=>'Standard', -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');

  $preprocess{keys} = ['None', &sorted_group_list];
  $widgets{standard} = $frame -> BrowseEntry(-variable => \$preprocess{standard_lab},
					     @browseentry_list,
					     -browsecmd => sub {
					       my $text = $_[1];
					       my $this = $1 if ($text =~ /^(\d+):/);
					       #Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless $this;
					       #$this -= 1;
					       $preprocess{standard} = $preprocess{keys}->[$this];
					       #if ($this == 0) { # choose None
					       if ($preprocess{standard} eq 'None') { # choose None
						 foreach (keys %widgets) {
						   $preprocess{ok} = 0;
						   next if ($_ eq 'standard');
						   next if ($_ =~ /^int/);
						   #next if ($_ eq 'deg_check');
						   #next if ($_ eq 'trun_check');
						   next if ($_ =~ /^(deg|mark|trun)/);
						   $widgets{$_}->configure(-state=>'disabled');
						   ($_ =~ /check$/) or
						     ($widgets{$_}->configure(-foreground=>$grey));
						 };
						 foreach (keys %labels) {
						   next if ($_ =~ /^(deg|mark|trun)/);
						   $labels{$_}->configure(-foreground=>$grey);
						 };
						 foreach (keys %grab) {
						   next if ($_ =~ /^(deg|trun)/);
						   $grab{$_}->configure(-state=>'disabled');
						 };
						 foreach (qw(deg_do trun_do int_do al_do par_do)) {
						   $preprocess{$_} = 0;
						 };
					       } else {	# choose a group
						 my $x = $preprocess{standard};
						 $preprocess{ok} = 1;
						 $widgets{mark_check}-> configure(-state=>'normal');
						 $widgets{deg_check} -> configure(-state=>'normal');
						 $widgets{trun_check}-> configure(-state=>'normal');
						 #$widgets{int_check}-> configure(-state=>'normal');
						 $widgets{al_check}  -> configure(-state=>'normal');
						 $widgets{par_check} -> configure(-state=>'normal');
						 $groups{$x}->dispose("___x = ceil($x.energy)\n", 1);
						 my $minE = $groups{$x}->{bkg_nor1}+$groups{$x}->{bkg_e0};
						 my $maxE = Ifeffit::get_scalar("___x");
						 my $toler = sprintf("%.4f", $groups{$x}->{bkg_step} * $config{deglitch}{margin});
						 $preprocess{deg_emin} = $groups{$x}->{deg_emin} || $minE;
						 $preprocess{deg_emax} = $groups{$x}->{deg_emax} || $maxE+$config{deglitch}{emax};
						 $preprocess{deg_tol}  = ($groups{$x}->{deg_tol} > 0) ? $groups{$x}->{deg_tol} : $toler;
						 $preprocess{trun_e}   = $maxE;
						 $preprocess{al_emin}  = -50;
						 $preprocess{al_emax}  = 150;
						 $groups{$x} -> make(deg_emin=>$minE, deg_emax=>$maxE, deg_tol=>$toler);
						 &set_key_params;
						 $groups{$x} -> plotE('emtg',$dmode);
						 $groups{$x} -> dispose("___x = floor($x.xmu)\n", 1);
						 $preprocess{ymin} = 0.95 * Ifeffit::get_scalar("___x");
						 $groups{$x} -> dispose("___x = ceil($x.xmu)\n", 1);
						 $preprocess{ymax} = 1.05 * Ifeffit::get_scalar("___x");
						 $groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
										   $preprocess{ymax}, $dmode, "truncate",
										   $groups{$x}->{plot_yoffset});
						 if ($preprocess{trun_do}) {
						   $widgets{"pp_trun_".$_} -> configure(-state=>'normal') foreach (qw(e beforeafter));
						   $grab{pp_trun_e}->configure(-state=>'normal');
						   $labels{trun_e}->configure(-foreground=>$blue);
						   $widgets{pp_trun_e}->configure(-foreground=>'black');
						 };
						 if ($preprocess{deg_do}) {
						   foreach (qw(deg_emin deg_emax deg_tol)) {
						     $labels{$_}->configure(-foreground=>$blue);
						     $widgets{$_}->configure(-state=>'normal',
									     -foreground=>'black');
						     $grab{'pp_'.$_}->configure(-state=>'normal');
						   };
						 };
					       };
					     })
    -> pack(-side=>'right', -expand=>1, -fill=>'x', -padx=>1);
  my $i = 1;
  $widgets{standard} -> insert("end", "0: None");
  foreach my $s (&sorted_group_list) {
    $widgets{standard} -> insert("end", "$i: $groups{$s}->{label}");
    ++$i;
  };

##   $widgets{standard} = $frame -> Optionmenu(-textvariable => \$preprocess{standard_lab},
## 					    -borderwidth=>1, )
##     -> pack(-side=>'right', -expand=>1, -fill=>'x', -padx=>1);
##   $widgets{standard} -> command(-label => 'None',
## 				-command=>sub{$preprocess{standard}='None';
## 					      $preprocess{standard_lab}='0: None';
## 					      foreach (keys %widgets) {
## 						$preprocess{ok} = 0;
## 						next if ($_ eq 'standard');
## 						next if ($_ =~ /^int/);
## 						#next if ($_ eq 'deg_check');
## 						#next if ($_ eq 'trun_check');
## 						next if ($_ =~ /^(deg|trun)/);
## 						$widgets{$_}->configure(-state=>'disabled');
## 						($_ =~ /check$/) or
## 						  ($widgets{$_}->configure(-foreground=>$grey)); };
## 					      foreach (keys %labels) {
## 						next if ($_ =~ /^(deg|trun)/);
## 						$labels{$_}->configure(-foreground=>$grey); };
## 					      foreach (keys %grab) {
## 						next if ($_ =~ /^(deg|trun)/);
## 						$grab{$_}->configure(-state=>'disabled'); };
## 					      foreach (qw(deg_do trun_do int_do al_do par_do)){
## 						$preprocess{$_} = 0; };
## 					    });
##   foreach my $x (&sorted_group_list) {
##     $widgets{standard} ->
##       command(-label => $groups{$x}->{label},
## 	      -command=>
## 	      sub{		# set preprocess parameters based on this group
## 		$preprocess{standard}=$x;
## 		$preprocess{standard_lab}=$groups{$x}->{label};
## 		$preprocess{ok} = 1;
## 		$widgets{deg_check}->configure(-state=>'normal');
## 		$widgets{trun_check}->configure(-state=>'normal');
## 		#$widgets{int_check}->configure(-state=>'normal');
## 		$widgets{al_check}->configure(-state=>'normal');
## 		$widgets{par_check}->configure(-state=>'normal');
## 		$groups{$x}->dispose("___x = ceil($x.energy)\n", 1);
## 		my $minE = $groups{$x}->{bkg_nor1}+$groups{$x}->{bkg_e0};
## 		my $maxE = Ifeffit::get_scalar("___x");
## 		my $toler = sprintf("%.4f", $groups{$x}->{bkg_step} * $config{deglitch}{margin});
## 		$preprocess{deg_emin} = $groups{$x}->{deg_emin} || $minE;
## 		$preprocess{deg_emax} = $groups{$x}->{deg_emax} || $maxE+$config{deglitch}{emax};
## 		$preprocess{deg_tol}  = ($groups{$x}->{deg_tol} > 0) ? $groups{$x}->{deg_tol} : $toler;
## 		$preprocess{trun_e}   = $maxE;
## 		$preprocess{al_emin}  = -50;
## 		$preprocess{al_emax}  = 150;
## 		$groups{$x} -> make(deg_emin=>$minE, deg_emax=>$maxE, deg_tol=>$toler);
## 		&set_key_params;
## 		$groups{$x} -> plotE('emtg',$dmode);
## 		$groups{$x} -> dispose("___x = floor($x.xmu)\n", 1);
## 		$preprocess{ymin} = 0.95 * Ifeffit::get_scalar("___x");
## 		$groups{$x} -> dispose("___x = ceil($x.xmu)\n", 1);
## 		$preprocess{ymax} = 1.05 * Ifeffit::get_scalar("___x");
## 		$groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
## 						  $preprocess{ymax}, $dmode, "truncate",
## 						  $groups{$x}->{plot_yoffset});
## 		if ($preprocess{trun_do}) {
## 		  $widgets{"pp_trun_".$_} -> configure(-state=>'normal') foreach (qw(e beforeafter));
## 		  $grab{pp_trun_e}->configure(-state=>'normal');
## 		  $labels{trun_e}->configure(-foreground=>$blue);
## 		  $widgets{pp_trun_e}->configure(-foreground=>'black');
## 		};
## 		if ($preprocess{deg_do}) {
## 		  foreach (qw(deg_emin deg_emax deg_tol)) {
## 		    $labels{$_}->configure(-foreground=>$blue);
## 		    $widgets{$_}->configure(-state=>'normal',
## 					    -foreground=>'black');
## 		    $grab{'pp_'.$_}->configure(-state=>'normal');
## 		  };
## 		};
## 	      });
##   };

  ## mark? =====================================================
  my $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{mark_check} = $frame -> Checkbutton(-text=>"Mark each data set when imported",
					       -foreground=>$config{colors}{activehighlightcolor},
					       -variable=>\$preprocess{mark_do},
					       -selectcolor=>$red,
					     )
    -> pack(-pady=>2, -side=>'left');


  ## truncate? =================================================
  #=$preprocess{trun_do} = 0;
  #=$preprocess{trun_e}  = 0;
  $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{trun_check} = $frame -> Checkbutton(-text=>"Truncate each data set",
					       -foreground=>$config{colors}{activehighlightcolor},
					       -variable=>\$preprocess{trun_do},
					       -selectcolor=>$red,
					       -command=>sub{
						 $preprocess{ok} = 1;
						 my $stst = ($config{general}{autoplot}) ? 'normal' : 'disabled';
						 my ($color, $text, $state, $button) = $preprocess{trun_do} ?
						   ($blue, 'black', 'normal', $stst) :
						     ($grey, $grey, 'disabled', 'disabled');
						 $labels{trun_e}->configure(-foreground=>$color);
						 $widgets{pp_trun_e}->configure(-state=>$state,
										-foreground=>$text);
						 $grab{pp_trun_e}->configure(-state=>$button);
						 $widgets{pp_trun_beforeafter}->configure(-state=>$state);
					       })
    -> pack(-pady=>2, -side=>'left');
  # truncate emax
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $grab{pp_trun_e} = $frame -> Button(@pluck_button, @pluck,
				      -command=>sub{$last_plot ||= 'e';
						    pluck('pp_trun_e');
						    my $x = $preprocess{standard};
						    return unless exists $groups{$x};
						    $groups{$x} -> plotE('emtg',$dmode);
						    $groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
										      $preprocess{ymax}, $dmode, "truncate",
										      $groups{$x}->{plot_yoffset});
						  },)
    -> pack(-side=>'right');
  $widgets{pp_trun_e} = $frame->Entry(-width	    => 8,
				      -textvariable => \$preprocess{trun_e},
				      -foreground => $grey,)
    -> pack(-side=>'right');
  $widgets{pp_trun_beforeafter} = $frame -> Optionmenu(-variable=>\$preprocess{trun_beforeafter},
						       -textvariable=>\$preprocess{trun_beforeafter},
						       -borderwidth=>1,
						       -options=>['before', 'after'],)
    -> pack(-side=>'right');
  $labels{trun_e} = $frame -> Label(-text=>'Truncate ')
    -> pack(-side=>'right');

  ## deglitch? ===================================================
  #=$preprocess{deg_do}   = 0;
  #=$preprocess{deg_emin} = 0;
  #=$preprocess{deg_emax} = 0;
  #=$preprocess{deg_tol}  = 0;
  $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{deg_check} = $frame -> Checkbutton(-text=>"Deglitch each data set",
					      -foreground=>$config{colors}{activehighlightcolor},
					      -variable=>\$preprocess{deg_do},
					      -selectcolor=>$red,
					      -command=>sub{
						$preprocess{ok} = 1;
						my $stst = ($config{general}{autoplot}) ? 'normal' : 'disabled';
						my ($color, $text, $state, $button) = $preprocess{deg_do} ?
						  ($blue, 'black', 'normal', $stst) :
						    ($grey, $grey, 'disabled', 'disabled');
						foreach (qw(deg_emin deg_emax deg_tol)) {
						  $labels{$_}->configure(-foreground=>$color);
						  $widgets{$_}->configure(-state=>$state,
									  -foreground=>$text);
						  next if ($_ eq 'deg_tol');
						  $grab{'pp_'.$_}->configure(-state=>$button);
						};
					      })
    -> pack(-pady=>2, -side=>'left', -anchor=>'w');
  # deglitch emin
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $grab{pp_deg_emin} = $frame -> Button(@pluck_button, @pluck,
					-command=>sub{$last_plot ||= 'e';
						      pluck('pp_deg_emin');
						      my $x = $preprocess{standard};
						      return unless $x;
						      $groups{$x} -> make(deg_emin=>$preprocess{deg_emin});
						      $groups{$x} -> plotE('emtg',$dmode);
						      $groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
											$preprocess{ymax}, $dmode, "truncate",
											$groups{$x}->{plot_yoffset});
					},)
    -> pack(-side=>'right');
  $widgets{deg_emin} = $frame->Entry(-width=>8, -textvariable=>\$preprocess{deg_emin},
				     -foreground=>$grey)
    -> pack(-side=>'right');
  $labels{deg_emin} = $frame -> Label(-text=>'Emin')
    -> pack(-side=>'right');
  # deglitch emax
  #$frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
  #  -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame -> Frame(-width=>5)
    -> pack(-side=>'right');
  $grab{pp_deg_emax} = $frame -> Button(@pluck_button, @pluck,
					-command=>sub{pluck('pp_deg_emax');
						      my $x = $preprocess{standard};
						      return unless $x;
						      $groups{$x} -> make(deg_emin=>$preprocess{deg_emax});
						      $groups{$x} -> plotE('emtg',$dmode);
						      $groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
											$preprocess{ymax}, $dmode, "truncate",
											$groups{$x}->{plot_yoffset});
					},)
    -> pack(-side=>'right');
  $widgets{deg_emax} = $frame->Entry(-width=>8, -textvariable=>\$preprocess{deg_emax},
				     -foreground=>$grey)
    -> pack(-side=>'right');
  $labels{deg_emax} = $frame -> Label(-text=>'Emax')
    -> pack(-side=>'right');
  # deglitch tolerance
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{deg_tol} = $frame->Entry(-width=>8, -textvariable=>\$preprocess{deg_tol},
				    -foreground=>$grey)
    -> pack(-side=>'right');
  $labels{deg_tol} = $frame -> Label(-text=>'Tolerance')
    -> pack(-side=>'right');

  ## interpolate? =================================================
  #=$preprocess{int_do} = 0;
  ##   $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
  ##     -> pack(-side=>'top', -expand=>1, -fill=>'x');
  ##   $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
  ##     -> pack(-side=>'top', -expand=>1, -fill=>'x');
  ##   $widgets{int_check} = $frame -> Checkbutton(-text=>"Interpolate to the standard",
  ## 					      -foreground=>$config{colors}{activehighlightcolor},
  ## 					      -variable=>\$preprocess{int_do},
  ## 					      -selectcolor=>$red,
  ## 					      -command=>sub{
  ## 						my $state = ($preprocess{int_do}) ?
  ## 						  'normal' : 'disabled';
  ## 						##$widgets{al_check} -> configure(-state=>$state);
  ## 					      })
  ##     -> pack(-pady=>2, -side=>'left');

  ## align? =================================================
  #=$preprocess{al_do} = 0;
  $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{al_check} = $frame -> Checkbutton(-text=>"Align to the standard",
					     -foreground=>$config{colors}{activehighlightcolor},
					     -variable=>\$preprocess{al_do},
					     -selectcolor=>$red,)
					     #-command=>sub{
					       #my ($color, $text, $state) = $preprocess{al_do} ?
					       # ($blue, 'black', 'normal') :
					       #   ($grey, $grey, 'disabled');
					       #foreach (qw(al_emin al_emax)) {
					       # $labels{$_}->configure(-foreground=>$color);
					       # $widgets{$_}->configure(-state=>$state,
					       #			 -foreground=>$color);
					       # $grab{'pp_'.$_}->configure(-state=>$state);
					       #};
					     #})
    -> pack(-pady=>2, -side=>'left');
  # alignment emin
  #$frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
  #  -> pack(-side=>'top', -expand=>1, -fill=>'x');
  #$grab{pp_al_emin} = $frame -> Button(@pluck_button, @pluck,
  #				       -command=>sub{Echo("Preprocessing pluck not yet working")},)
  #  -> pack(-side=>'right');
  #$widgets{al_emin} = $frame->Entry(-width=>8, -textvariable=>\$preprocess{al_emin},
  #				    -foreground=>$grey)
  #  -> pack(-side=>'right');
  #$labels{al_emin} = $frame -> Label(-text=>'Emin')
  #  -> pack(-side=>'right');
  # alignment emax
  #$frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
  #  -> pack(-side=>'top', -expand=>1, -fill=>'x');
  #$grab{pp_al_emax} = $frame -> Button(@pluck_button, @pluck,
  #				       -command=>sub{Echo("Preprocessing pluck not yet working")},)
  #  -> pack(-side=>'right');
  #$widgets{al_emax} = $frame->Entry(-width=>8, -textvariable=>\$preprocess{al_emax},
  #				    -foreground=>$grey)
  #  -> pack(-side=>'right');
  #$labels{al_emax} = $frame -> Label(-text=>'Emax')
  #  -> pack(-side=>'right');

  ## params? ===================================================
  #=$preprocess{par_do} = 0;
  $outer = $parent -> Frame(-relief=>'groove', -borderwidth=>2)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $frame = $outer -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{par_check} = $frame -> Checkbutton(-text=>"Set parameters to the standard",
					      -foreground=>$config{colors}{activehighlightcolor},
					      -variable=>\$preprocess{par_do},
					      -selectcolor=>$red,
					     )
    -> pack(-pady=>2, -side=>'left');


  ## buttons ===================================================
  $frame = $parent -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-expand=>1, -fill=>'x');
  $frame -> Button(-text=>'Replot standard', -width=>5, @button_list,
		   -command=>sub{
		     my $x = $preprocess{standard};
		     $groups{$x} -> make(deg_emin=>$preprocess{deg_emin},
					 deg_emax=>$preprocess{deg_emax},
					 deg_tol =>$preprocess{deg_tol});
		     &set_key_params;
		     $groups{$x} -> plotE('emtg',$dmode);
		     $groups{$x} -> plot_vertical_line($preprocess{trun_e}, $preprocess{ymin},
						       $preprocess{ymax}, $dmode, "truncate",
						       $groups{$x}->{plot_yoffset});
		   })
    -> pack(-expand=>1, -fill=>'x', -padx=>1, -pady=>2, -side=>'left');
  ##$frame -> Button(-text=>'Dismiss extras', -width=>5, @button_list,
  ##		   -command => sub{remove_extras($widg)} )
  ##  -> pack(-expand=>1, -fill=>'x', -padx=>1, -pady=>2, -side=>'right');

  ## initial setup
  my $notnone = $config{colors}{activehighlightcolor};
  foreach (qw(deg_emin deg_emax deg_tol)) {
    my $active = (($preprocess{standard} ne 'None') and $preprocess{deg_do});
    $labels{$_}->configure(-foreground=> $active ? '#9c9583' : $notnone);
  };
  foreach (qw(trun_e)) {
    my $active = (($preprocess{standard} ne 'None') and $preprocess{trun_do});
    $labels{$_}->configure(-foreground=> $active ? '#9c9583' : $notnone);
  };
  foreach (keys %widgets) {
    next if ($_ eq 'standard'); # or ($_ =~ /(deg|trun)_check/));
    $widgets{$_}->configure(-state=>$initial_state);
  };
  foreach (keys %grab) {
    $grab{$_}->configure(-state=>$initial_state);
  };
  $widgets{standard} -> configure(-state=>'disabled') if $how_many == 1;
  map { $widgets{$_} -> configure(-state=>'normal') } (qw(mark_check trun_check deg_check));
  #$pre -> grab;
  return $parent;
};


## evkev for deglitching??  wait til someone complains
sub perform_preprocessing {
  if ($preprocess{standard} eq 'None') {
    return 0 unless ($preprocess{trun_do} or $preprocess{deg_do});
  };
  my $group = $_[0];
  my $stan = $preprocess{standard};
  my $eshift = 0;
  $preprocess{titles} = ["^^ Preprocessing chores performed:"];
  Echo("Performing preprocessing chores on $groups{$group}->{label} ... ");
  if ($preprocess{trun_do}) {
    Echo("Truncating $groups{$group}->{label}", 0);
    my $factor = ($preprocess{evkev} eq 'kev') ? 1000 : 1;
    $groups{$group}->make(etruncate=>$preprocess{trun_e}*$factor);
    push @{$preprocess{titles}}, "^^    truncation at $preprocess{trun_e}";
    truncate_data($group, 1, $preprocess{trun_beforeafter}, 'mu(E)');
  };
  if ($preprocess{deg_do}) {
    Echo("Deglitching $groups{$group}->{label}", 0);
    $groups{$group}->make(deg_emin=>$preprocess{deg_emin},
			  deg_emax=>$preprocess{deg_emax},
			  deg_tol =>$preprocess{deg_tol});
    $groups{$group}->dispatch_bkg($dmode);
    my $cmd = sprintf("set %s.postline = %g+%g*%s.energy+%g*%s.energy**2\n",
		      $group, $groups{$group}->{bkg_nc0}, $groups{$group}->{bkg_nc1},
		      $group, $groups{$group}->{bkg_nc2}, $group);
    $groups{$group}->dispose($cmd, $dmode);
    remove_glitches($group, 1);	# remove em, but don't plot yet
    push @{$preprocess{titles}}, "^^    deglitching with margins $preprocess{deg_emin}, $preprocess{deg_emax}, and $preprocess{deg_tol}";
  };
  if ($preprocess{int_do}) {
    Echo("Interpolating $groups{$group}->{label}", 0);
    $groups{$stan} -> interpolate($groups{$group}, 'e', $dmode);
    push @{$preprocess{titles}}, "^^    interpolation onto grid of $groups{$stan}->{label}";
  };

  ## need to do alignment a bit later in case we want to align using
  ## the reference channels

  if ($preprocess{par_do}) {
    Echo("Setting parameters for $groups{$group}->{label}", 0);
    $groups{$group} -> set_to_another($groups{$stan});
    push @{$preprocess{titles}}, "^^    constraint of parameters to $groups{$stan}->{label}";
  };
  Echo("Finished with preprocessing!", 0);
};


sub perform_rebinning {
  return 0 unless $rebin{do_rebin};
  #Error("You forgot to specify an absorber for rebinning."),
  return 0 if ($rebin{abs} =~ /^\s*$/);
  #Error("\"$rebin{abs}\" is not a valid element symbol."),
  return 0 unless (lc($rebin{abs}) =~ /^$Ifeffit::Files::elem_regex$/);
  ## make sure these are all defined
  $rebin{emin}  ||= $config{rebin}{emin};
  $rebin{emax}  ||= $config{rebin}{emax};
  $rebin{pre}   ||= $config{rebin}{pre};
  $rebin{xanes} ||= $config{rebin}{xanes};
  $rebin{exafs} ||= $config{rebin}{exafs};
  ## these must be positive or bad stuff will happen
  $rebin{pre}   = abs($rebin{pre});
  $rebin{xanes} = abs($rebin{xanes});
  $rebin{exafs} = abs($rebin{exafs});
  ## check if emin, emax out of order
  (($rebin{emin}, $rebin{emax}) = ($rebin{emax}, $rebin{emin})) if
    ($rebin{emin} > $rebin{emax});

  my $group = $_[0];

  my @e = Ifeffit::get_array("$group.energy");
  my ($efirst, $elast) = ($e[0], $e[$#e]);
  my ($ek, $el1, $el2, $el3) = (Xray::Absorption->get_energy($rebin{abs}, 'K'),
				Xray::Absorption->get_energy($rebin{abs}, 'L1'),
				Xray::Absorption->get_energy($rebin{abs}, 'L2'),
				Xray::Absorption->get_energy($rebin{abs}, 'L3'));
  my ($e0, $edge);
 SWITCH: {
    (($e0, $edge) = ($ek,  'K')),  last SWITCH if (($ek  > $efirst) and ($ek  < $elast));
    (($e0, $edge) = ($el3, 'L3')), last SWITCH if (($el3 > $efirst) and ($el3 < $elast));
    (($e0, $edge) = ($el2, 'L2')), last SWITCH if (($el2 > $efirst) and ($el2 < $elast));
    (($e0, $edge) = ($el1, 'L1')), last SWITCH if (($el1 > $efirst) and ($el1 < $elast));
    Error("These data cannot be of absorber $rebin{abs}!  No edge of that element lies within the energy range."), return;
  };
  Echo("Rebinning data $groups{$group}->{label} ($rebin{abs} $edge-edge) ...");
  $groups{$group}->dispose("## Rebinning group $group:", $dmode);
  my @bingrid;
  my $ee = $efirst;
  while ($ee < $rebin{emin}+$e0) {
    push @bingrid, $ee;
    $ee += $rebin{pre};
  };
  $ee = $rebin{emin}+$e0;
  while ($ee < $rebin{emax}+$e0) {
    push @bingrid, $ee;
    $ee += $rebin{xanes};
  };
  $ee = $rebin{emax}+$e0;
  my $kk = $groups{$group}->e2k($rebin{emax});
  while ($ee < $elast) {
    push @bingrid, $ee;
    $kk += $rebin{exafs};
    $ee = $e0 + $groups{$group}->k2e($kk);
  };
  push @bingrid, $elast;
  Ifeffit::put_array("$group.xxx", \@bingrid);
  foreach my $y (split(" ", &column_string)) {
    next if ($y eq 'energy');
    ## also do not want to rebin, say, $g.1 if "1" is the energy column
    $groups{$group}->dispose("set $group.rebin = rebin($group.energy, $group.$y, $group.xxx)", $dmode);
    $groups{$group}->dispose("set $group.$y = $group.rebin", $dmode);
  };
  $groups{$group}->dispose("set $group.energy = $group.xxx", $dmode);
  $groups{$group}->dispose("erase $group.xxx $group.rebin", $dmode);
  #$groups{$group}->dispose("erase $group.rebin", $dmode);
  $rebin{titles} =
    ["^^ Rebinned data onto grid [$rebin{emin}:$rebin{emax}] with steps ($rebin{pre},$rebin{xanes},$rebin{exafs})"];

  Echo("Rebinning data $groups{$group}->{label} ($rebin{abs} $edge-edge) ... done!");
};

sub set_reference {
  my $parent	= $_[0] -> Frame(-borderwidth=>0, -relief=>'flat');
  my $group	= $_[1];
  my $cols	= $_[2];
  my $widg	= $_[3];
  my $reference	= $_[4];
  my $energy    = $_[5];

  ## set some variables
  my $red = $config{colors}{single};
  my $blue= $config{colors}{activehighlightcolor};
  my $grey= '#9c9583';

  $parent -> Label(-text=>'Reference channel',
		   -font=>$config{fonts}{bold},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack();
  $parent -> Label(-text=>'The reference uses the same energy array as the data.',
		   -relief=>'groove',
		  )
    -> pack(-ipadx=>2, -ipady=>2);
  my $fr = $parent -> Scrolled('Pane', -relief=>'flat', -borderwidth=>2,
			       -gridded=>'xy',
			       -scrollbars=>'os', -sticky => 'ew',)
    -> pack(-expand=>1, -fill=>'x');
  $fr->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
  $fr -> Label(-text=>' ', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $fr -> Label(-text=>'Numerator', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $fr -> Label(-text=>'Denominator', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  my $j = 1;
  foreach (@$cols) {
    my $this = $group.".".$_;
    #my $this = $_;

    $fr -> Label(-text=>$_)
      -> grid(-row=>0, -column=>$j);
    my $jj = $j;  # need a counter that is scoped HERE
    $fr -> Radiobutton(-variable=>\$$reference{numerator},
		       -value=>$this,
		       -text=>"",
		       -selectcolor=>$red,
		      )
      -> grid(-row=>1, -column=>$j,);
    $fr -> Radiobutton(-variable=>\$$reference{denominator},
		       -value=>$this,
		       -text=>"",
		       -selectcolor=>$red,
		       )
      -> grid(-row=>2, -column=>$j,);
    ++$j;
  };

  $fr = $parent -> Frame()
    -> pack();
  $fr -> Checkbutton(-text=>"Natural log", -variable=>\$$reference{ln}, -selectcolor=>$red,)
    -> pack(-side=>'left', -fill=>'x', -anchor=>'w');
  $fr -> Checkbutton(-text=>"Same element", -variable=>\$$reference{same}, -selectcolor=>$red,)
    -> pack(-side=>'left', -fill=>'x', -anchor=>'w', -padx=>2);
  $fr -> Button(-text=>"Plot reference",
		-borderwidth=>1,
		-command=>sub{
		  Echo("Not enough information to plot reference"), return unless
		    ($$reference{numerator} or $$reference{denominator});
		  my $str = "$$reference{numerator}/$$reference{denominator}";
		  $str = "ln(abs( $str ))" if $$reference{ln};
		  my $en = $$energy;
		  my $command = "\n## Plot reference in the file selection dialog:\n";
		  $command   .= "set t___oss.y = $str\n";
		  $command   .= "newplot(x=$en, y=t___oss.y, ";
		  $command   .= "color=$config{plot}{c0}, title=\"current reference selection\", xlabel=x, ylabel=y)\n";
		  $command   .= "erase \@group t___oss\n";
		  $groups{"Default Parameters"}->dispose($command, $dmode);
		},
	       )
    -> pack(-side=>'left', -fill=>'x', -anchor=>'w', -padx=>2);
  $fr = $parent -> Frame()
    -> pack(-side=>'bottom', -anchor=>'w', -pady=>4);
  $fr -> Button(-text=>'Clear reference channels', @button_list,
		-command=>sub{$$reference{numerator}   = 0;
			      $$reference{denominator} = 0;
			      $$reference{ln}          = 1;
			      $$reference{same}        = 1;
			    })
    -> pack(-side=>'left', -fill=>'x', -padx=>8, -anchor=>'e');
  ##$fr -> Button(-text=>'Dismiss extras', @button_list,
  ##		-command=>sub{remove_extras($widg)})
  ##  -> pack(-side=>'left', -fill=>'x', -padx=>8, -anchor=>'e');
  return $parent;
};


sub set_bin {
  my $widg = $_[0];
  my $ppp = $$widg{bin_card};
  my $parent = $ppp -> Frame(-borderwidth=>0, -relief=>'flat');

  $parent -> Label(-text=>'Data rebinning',
		   -font=>$config{fonts}{bold},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack();
  $parent -> Checkbutton(-text=>"Perform rebinning",
			 -variable=>\$rebin{do_rebin})
    -> pack(-pady=>4);

  my $frame = $parent -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-expand=>1, -fill=>'x');
  $frame -> Label(-text=>'Absorber:',
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widget{rebin_abs} = $frame -> Entry(-width=>5, -textvariable=>\$rebin{abs})
    -> grid(-row=>0, -column=>1, -sticky=>'w', -padx=>2);

  $frame -> Label(-text=>'Edge region from:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin{emin},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>1, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>' to ',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>2);
  $frame -> Entry(-width=>5, -textvariable=>\$rebin{emax},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>1, -column=>3, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>4);

  $frame -> Label(-text=>'Pre edge grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin{pre},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>2, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>2, -sticky=>'w',);

  $frame -> Label(-text=>'XANES grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin{xanes},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>3, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>2, -sticky=>'w',);

  $frame -> Label(-text=>'EXAFS grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin{exafs},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>4, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'invAng',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>4, -column=>2, -sticky=>'w',);

  $frame = $parent -> Frame(-relief=>'flat', -borderwidth=>0)
    -> pack(-expand=>1, -fill=>'x', -pady=>4);
  ##$frame -> Button(-text=>'Dismiss extras', -width=>5, @button_list,
  ##		   -command => sub{remove_extras($widg)} )
  ##  -> pack(-expand=>1, -fill=>'x', -padx=>1, -pady=>2, -side=>'right');

  return $parent;
};

## sub set_favorites {
##   my $widg = $_[0];
##   my $ppp = $$widg{fav_card};
##   my $parent = $ppp -> Frame(-borderwidth=>0, -relief=>'flat');
##
##   $parent -> Label(-text=>'Favorite file types',
## 		   -font=>$config{fonts}{bold},
## 		   -foreground=>$config{colors}{activehighlightcolor})
##     -> pack();
##
##   my $text = $parent -> ROText(-wrap=>'word', -width=>1, -height=>10, -relief=>'flat')
##     -> pack(-expand=>1, -fill=>'both');
##   $text -> insert('end', "This space will contain an as-yet unimplemented, user-definable list of file types.  Selecting one will serve as a short cut to setting the column checkboxes for the numerator and denominator, allowing you to quickly specify common column selections.");
##
##   my $frame = $parent -> Frame(-relief=>'flat', -borderwidth=>0)
##     -> pack(-expand=>1, -fill=>'x');
##   $frame -> Button(-text=>'Dismiss extras', -width=>5, @button_list,
## 		   -command => sub{remove_extras($widg)} )
##     -> pack(-expand=>1, -fill=>'x', -padx=>1, -pady=>2, -side=>'right');
##
##   return $parent;
## };


sub remove_extras {
  my $widg = $_[0];
  $$widg{extras} -> packForget;
  $top -> update; # needed so $raw resizes correctly
  $$widg{extra_button} -> pack(-expand=>1, -fill=>'x', -pady=>0);
  $$widg{right}->pack(-expand=>1, -fill=>'both',
		      -side=>'right', -anchor=>'n');
  $$widg{databox}->pack(-expand=>1, -fill=>'both',
			-padx=>4, -pady=>2);
  $$prior_args{extra_shown} = 0;
  ## removing this frame says that the user does not want to do any of these
  ## chores, so turn them all off
  $preprocess{ok}=0;
}






## save data in the selected space (a misnomer, since mu(E) can also
## be saved by this subroutine
sub save_chi {
  Echo('No data!'), return unless ($current);
  my ($space, $in_loop, $dir) = @_;
  $space = lc($space);
  Echo("You cannot save chi for the Default Parameters"), return 0
    if ($current eq "Default Parameters");
  $top -> Busy;
  my $this = $in_loop || $current;
  my ($suffix, $text) = ('chi', 'chi(k)');
 SWITCH: {
    (($suffix, $text) = ('chi1', 'k*chi(k)')),         last SWITCH if ($space eq 'k1');
    (($suffix, $text) = ('chi2', 'k^2*chi(k)')),       last SWITCH if ($space eq 'k2');
    (($suffix, $text) = ('chi3', 'k^3*chi(k)')),       last SWITCH if ($space eq 'k3');
    (($suffix, $text) = ('chie', 'chi(E)')),           last SWITCH if ($space eq 'ke');
    (($suffix, $text) = ('xmu',  'mu(E)')),            last SWITCH if ($space eq 'e');
    (($suffix, $text) = ('nor',  'normalized mu(E)')), last SWITCH if ($space eq 'n');
    (($suffix, $text) = ('der',  'derivative mu(E)')), last SWITCH if ($space eq 'd');
    (($suffix, $text) = ('bkg',  'bkg(E)')),           last SWITCH if ($space eq 'b');
    (($suffix, $text) = ('rsp',  'chi(R)')),           last SWITCH if ($space eq 'r');
    (($suffix, $text) = ('qsp',  'chi(q)')),           last SWITCH if ($space eq 'q');
  };
  Echo("Saving $text data ...", 0);
  #local $Tk::FBox::a;
  #local $Tk::FBox::b;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [["EXAFS $text data", ".".$suffix],
	       ['All + hidden', '*']];
  ##(my $initial = join(".", $this, $suffix)) =~ s/\?/_/g;
  my $initial = join(".", $groups{$this}->{label}, $suffix);
  # spaces are common in filenames on Mac and Win, but not on un*x
  ($initial =~ s/\s+/_/g) unless ($is_windows or $is_darwin);
  ($initial =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  my $file = q{};
  if ($in_loop) {
    $file = File::Spec->catfile($dir, $initial);
  } else {
    $file = $top -> getSaveFile(-defaultextension=>$suffix,
				-filetypes=>$types,
				#(not $is_windows) ?
				#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-initialfile=>$initial,
				-title => "Athena: Save $text data");
  };
  if ($file) {
    ## make sure I can write to $file
    open F, ">".$file or do {
      $top -> Unbusy;
      Error("You cannot write to \"$file\".");
      return
    };
    close F;
    my ($name, $pth, $suffix) = fileparse($file);
    $current_data_dir = $pth;
    ##&push_mru($file);
    my $stdev = "";
    if ($groups{$this}->{is_merge} eq $space) {
      $stdev = ", $this.stddev"
    };
    refresh_titles($groups{$this}); # make sure titles are up-to-date
    $groups{$this}->dispose("\$id_line = \"Athena data file -- Athena version $VERSION\"");
    #$groups{$this}->dispose("\$id2_line = \"Saving $groups{$this}->{label} (group=$groups{$this}->{group}) as $text\"");
    $groups{$this}->dispose("\$id2_line = \"Saving $groups{$this}->{label} as $text\"");
    my $i = 0;
    foreach my $l (split(/\n/, $groups{$this}->param_summary)) {
      ++$i;
      $groups{$this}->dispose("\$param_line_$i = \"$l\"");
    };

  SWITCH: {			# what about mu(E), mu0(E), pre(E),
                                # post(E), window(?)
      (($space eq 'e') and ($groups{$this}->{not_data})) and do {
	my $esh = $groups{$this}->{bkg_eshift};
	$groups{$this}->dispose("set $this.ee = $this.energy+$esh", $dmode);
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.det)\n", $dmode);
	$groups{$this}->dispose("erase $this.ee", $dmode);
	last SWITCH;
      };
      ($space eq 'e') and do {
	$groups{$this}->dispatch_bkg($dmode);
	my $suff = ($groups{$this}->{bkg_cl}) ? "f2" : "bkg";
	my $esh = $groups{$this}->{bkg_eshift};
	my $i0 = ($groups{$this}->{i0}) ? ", $this.i0" : "";
	$groups{$this}->dispose("set $this.ee = $this.energy+$esh", $dmode);
	$groups{$this}->dispose("set $this.der = deriv($this.xmu)/deriv($this.energy)", $dmode);
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.xmu, $this.$suff, $this.der $stdev$i0, $this.preline, $this.postline)\n", $dmode);
	$groups{$this}->dispose("erase $this.ee $this.der", $dmode);
	last SWITCH;
      };
      ($space eq 'n') and do {
	##($groups{$this}->{update_bkg}) and
	$groups{$this}->dispatch_bkg($dmode);
	my $suff = "f2norm";
	my $esh = $groups{$this}->{bkg_eshift};
	my $i0 = ($groups{$this}->{i0}) ? ", $this.i0" : "";
	unless ($groups{$this}->{bkg_cl}) {
	  $groups{$this}->dispose("$this.bkg_norm=($this.bkg-$this.preline)/$groups{$this}->{bkg_step}", $dmode);
	  $suff = "bkg_norm";
	};
	$groups{$this}->dispose("set $this.der_norm = deriv($this.norm)/deriv($this.energy)", $dmode);
	$groups{$this}->dispose("set $this.ee = $this.energy+$esh", $dmode);
	if ($groups{$this}->{bkg_flatten}) {
	  my $label = "energy norm";
	  $label   .= " bkg_norm" if (not $groups{$this}->{is_xanes});
	  $label   .= " der_norm";
	  $label   .= " stddev"   if $groups{$this}->{is_merge};
	  $label   .= " i0"       if $groups{$this}->{i0};
	  my $fbkg = ($groups{$this}->{is_xanes}) ? "" : ", $this.fbkg";
	  $groups{$this}->dispose("write_data(file=\"$file\", label=\"$label\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.flat $fbkg, $this.der_norm $stdev $i0)\n", $dmode);
	} else {
	  my $fbkg = ($groups{$this}->{is_xanes}) ? "" : ", $this.$suff";
	  $groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.norm $fbkg, $this.der_norm $stdev $i0)\n", $dmode);
	};
	$groups{$this}->dispose("erase $this.ee", $dmode);
	($groups{$this}->{bkg_cl}) or
	  $groups{$this}->dispose("erase $this.bkg_norm $this.der_norm", $dmode);
	last SWITCH;
      };
      ($space eq 'd') and do {
	my $esh = $groups{$this}->{bkg_eshift};
	$groups{$this}->dispatch_bkg($dmode);
	$groups{$this}->dispose("set $this.ee = $this.energy+$esh", $dmode);
	$groups{$this}->dispose("set $this.deriv = deriv($this.xmu)/deriv($this.energy)", $dmode);
	my $i0 = ($groups{$this}->{i0}) ? ", $this.i0" : "";
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.deriv $i0)\n", $dmode);
	$groups{$this}->dispose("erase $this.ee $this.deriv", $dmode);
	last SWITCH;
      };
      ($space eq 'b') and do {
	my $suff = ($groups{$this}->{bkg_cl}) ? "f2norm" : "bkg";
	my $esh = $groups{$this}->{bkg_eshift};
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	$groups{$this}->dispose("set $this.ee = $this.energy+$esh", $dmode);
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.ee, $this.$suff)\n", $dmode);
	$groups{$this}->dispose("erase $this.ee", $dmode);
	last SWITCH;
      };
      ($space eq 'k') and do {
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	($groups{$this}->{update_fft}) and $groups{$this}->do_fft($dmode, \%plot_features);
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.k, $this.chi $stdev, $this.win)\n", $dmode);
	last SWITCH;
      };
      ($space =~ /k(\d)/) and do { # k-weighted chi(k) output (note stddev not to scale)
	my $kw = $1;
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	($groups{$this}->{update_fft}) and $groups{$this}->do_fft($dmode, \%plot_features);
	$groups{$this}->dispose("set $this.chik = $this.chi * $this.k**$kw", $dmode);
	ifeffit("set ___x = ceil($this.chik)"); # scale window to plot
	my $scale = 1.05 * Ifeffit::get_scalar("___x");
	$groups{$this}->dispose("set $this.winout = $scale*$this.win");
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.k, $this.chik $stdev, $this.winout)\n", $dmode);
	$groups{$this}->dispose("erase $this.chik $this.winout", $dmode);
	last SWITCH;
      };
      ($space eq 'r') and do {
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	($groups{$this}->{update_fft}) and $groups{$this}->do_fft($dmode, \%plot_features);
	($groups{$this}->{update_bft}) and $groups{$this}->do_bft($dmode);
	ifeffit("set ___x = ceil($this.chir_mag)"); # scale window to plot
	my $scale = 1.05 * Ifeffit::get_scalar("___x");
	$groups{$this}->dispose("set $this.winout = $scale*$this.rwin");
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*,\n           $this.r, $this.chir_re, $this.chir_im, $this.chir_mag, $this.chir_pha, $this.winout)\n", $dmode);
	$groups{$this}->dispose("erase $this.winout", $dmode);
	last SWITCH;
      };
      ($space eq 'ke') and do {
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	my $e0      = $groups{$this}->{bkg_e0};
	my $command = "$this.eee = $this.k^2/etok+$e0$/\n";
	$command   .= "write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.eee, $this.chi)\n";
	$groups{$this}->dispose($command, $dmode);
	last SWITCH;
      };
      ($space eq 'q') and do {
	($groups{$this}->{update_bkg}) and $groups{$this}->dispatch_bkg($dmode);
	($groups{$this}->{update_fft}) and $groups{$this}->do_fft($dmode, \%plot_features);
	($groups{$this}->{update_bft}) and $groups{$this}->do_bft($dmode);
	$groups{$this}->dispose("write_data(file=\"$file\", \$id_line, \$id2_line, \$param_line_\*, \$${this}_title_\*, $this.q, $this.chiq_re, $this.chiq_im, $this.chiq_mag, $this.chiq_pha)\n", $dmode);
	last SWITCH;
      };
    };
    Echo("Saving $text data to $file ... done", 0);
    my $memory_ok = $groups{$this}->memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
    Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
  } else {
    Echo("Saving $text data ... canceled", 0);
  };
  $top -> Unbusy;
  return $text;
};


sub save_marked {
  my $m = 0;
  map {$m += $_} values %marked;
  Error("Saving file aborted.  There are no marked groups."), return 1 unless ($m);
  my $maxcol = Ifeffit::get_scalar('&max_output_cols') || 16;
  --$maxcol;
  Error("You cannot save more than $maxcol groups to a single file."), return if ($m>$maxcol);
  my $sp = $_[0];
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;

  my ($x, $y, $mess) = ('','','');
 SWITCH: {
      ($x, $y, $mess) = ('energy','xmu', "mu(E)"),                       last SWITCH if ($sp eq 'e');
      ($x, $y, $mess) = ('energy','norm', "normalized mu(E)"),           last SWITCH if ($sp eq 'n');
      ($x, $y, $mess) = ('energy','deriv', "derivative mu(E)"),          last SWITCH if ($sp eq 'd');
      ($x, $y, $mess) = ('energy','nderiv', "derivative norm(E)"),       last SWITCH if ($sp eq 'nd');
      ($x, $y, $mess) = ('k','chi', "chi(k)"),                           last SWITCH if ($sp eq 'k');
      ($x, $y, $mess) = ('k','chi1', "k*chi(k)"),                        last SWITCH if ($sp eq 'k1');
      ($x, $y, $mess) = ('k','chi2', "k^2*chi(k)"),                      last SWITCH if ($sp eq 'k2');
      ($x, $y, $mess) = ('k','chi3', "k^3*chi(k)"),                      last SWITCH if ($sp eq 'k3');
      ($x, $y, $mess) = ('energy','chi', "chi(E)"),                      last SWITCH if ($sp eq 'ke');
      ($x, $y, $mess) = ('r','chir_mag', "the magnitude of chi(R)"),     last SWITCH if ($sp eq 'rm');
      ($x, $y, $mess) = ('r','chir_re', "the real part of chi(R)"),      last SWITCH if ($sp eq 'rr');
      ($x, $y, $mess) = ('r','chir_im', "the imaginary part of chi(R)"), last SWITCH if ($sp eq 'ri');
      ($x, $y, $mess) = ('q','chiq_mag', "the magnitude of chi(q)"),     last SWITCH if ($sp eq 'qm');
      ($x, $y, $mess) = ('q','chiq_re', "the real part of chi(q)"),      last SWITCH if ($sp eq 'qr');
      ($x, $y, $mess) = ('q','chiq_im', "the imaginary part of chi(q)"), last SWITCH if ($sp eq 'qi');
    };
  my $types = [['All Files', '*'],[$x, '.'.$y]];
  my $path = $current_data_dir || Cwd::cwd;
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>"marked.".$y,
				 -title => "Athena: Save marked groups as $mess");
  return unless $file;
  ## make sure I can write to $file
  open F, ">".$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  close F;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  #&push_mru($file);
  Echo("Saving $mess for each marked group ...");
  $top -> Busy;

  $groups{$current} -> dispose("\n## saving marked groups as columns in a file", $dmode);
  my @list = (&sorted_group_list);
  ## determine first marked group so we can use its energy array
  my $first;
  foreach (@list) {
    ($first = $_), last if $marked{$_};
  };
  my ($label, $alt_label) = ($x, $x);
  my $command = "file=\"$file\", \$marked_title_\*, ";
  $groups{$current}->dispose("\$marked_title_1 = \"Athena multicolumn data file -- Athena version $VERSION\"");
  my $erase = "erase \$marked_title_1\n";
  $groups{$current}->dispose("\$marked_title_2 = \"This file contains $mess from:\"");
  $erase .= "erase \$marked_title_2\n";
  if ($x eq "energy") {
    $groups{$first}->dispose("set $first.ee = $first.energy+$groups{$first}->{bkg_eshift}", $dmode);
    $command .= "$first.ee";
    $erase   .= "erase $first.ee\n";
  } else {
    $command .= "$first.$x";
  };
  my $ncol = 0;
  my $stan;
  foreach my $g  (@list) {
    next unless $marked{$g};
    next if (($x ne 'energy') and  ($groups{$g}->{not_data}));
    next if (($x eq 'energy') and (($groups{$g}->{is_chi}) or ($groups{$g}->{is_rsp}) or
				   ($groups{$g}->{is_qsp})));
    next if (($x eq 'k')      and (($groups{$g}->{is_rsp}) or ($groups{$g}->{is_qsp})));
    next if (($x eq 'r')      and  ($groups{$g}->{is_qsp}));
    ## bring up to date if needed
    $groups{$g}->dispatch_bkg($dmode)            if $groups{$g}->{update_bkg};
    $groups{$g}->do_fft($dmode, \%plot_features) if (($x =~ /^[qr]$/) and $groups{$g}->{update_fft});
    $groups{$g}->do_bft($dmode)                  if (($x eq 'q')      and $groups{$g}->{update_bft});
    ## column label
    (my $this_lab = $groups{$g}->{label}) =~ s/[^A-Za-z0-9_&:?@~]+/_/g;
    $label .= "  $this_lab";
    ## interpolate if energy and not the first column
    my $yy = $y;
    ($ncol) or ($stan = $g);
    if (($ncol) and ($y eq 'deriv')) {
      my ($e0stan, $e0g) = ($groups{$stan}->{bkg_eshift},$groups{$g}->{bkg_eshift});
      $yy = sprintf "deriv_%s", $ncol+1;
      $groups{$g}->dispose("set $g.$yy = deriv($g.xmu)/deriv($g.energy)", $dmode);
      $groups{$g}->dispose("set $g.$yy = qinterp($g.energy+$e0g, $g.$yy, $stan.energy+$e0stan)",
			   $dmode);
      $erase .= "erase $g.$yy\n";
    } elsif ($y eq 'nderiv') {
      my ($e0stan, $e0g) = ($groups{$stan}->{bkg_eshift},$groups{$g}->{bkg_eshift});
      $yy = sprintf "nderiv_%s", $ncol+1;
      $groups{$g}->dispose("set $g.$yy = deriv($g.norm)/deriv($g.energy)", $dmode);
      $groups{$g}->dispose("set $g.$yy = qinterp($g.energy+$e0g, $g.$yy, $stan.energy+$e0stan)",
			   $dmode);
      $erase .= "erase $g.$yy\n";
    } elsif (($ncol) and ($x eq 'energy')) {
      my ($e0stan, $e0g) = ($groups{$stan}->{bkg_eshift},$groups{$g}->{bkg_eshift});
      $yy = sprintf "%s_%s", $y, $ncol+1;
      if (($y eq 'norm') and $groups{$g}->{bkg_flatten}) {
	$groups{$g}->dispose("set $g.$yy = qinterp($g.energy+$e0g, $g.flat, $stan.energy+$e0stan)",
			     $dmode);
      } else {
	$groups{$g}->dispose("set $g.$yy = qinterp($g.energy+$e0g, $g.$y, $stan.energy+$e0stan)",
			     $dmode);
      };
      $erase .= "erase $g.yy\n";
    } elsif ($y =~ /chi(\d)/) {
      $yy = sprintf "%s_%s", $y, $ncol+1;
      my $kw = $1;
      $groups{$g}->dispose("set $g.$yy = $g.chi * $g.k**$kw", $dmode);
      $erase .= "erase $g.$yy\n";
    } else {
      $yy = sprintf "%s_%s", $y, $ncol+1;
      if ($y eq 'deriv') {
	$groups{$g}->dispose("set $g.$yy = deriv($g.xmu)/deriv($g.energy)", $dmode);
      } elsif (($y eq 'norm') and ($groups{$g}->{bkg_flatten})) {
	$groups{$g}->dispose("set $g.$yy = $g.flat", $dmode);
      } else {
	$groups{$g}->dispose("set $g.$yy = $g.$y", $dmode);
      };
      $erase .= "erase $g.$yy\n";
    };
    $command .= ", $g.$yy";
    ++$ncol;
    $alt_label .= " $ncol";
    my $nmess = $ncol+1;
    my $ntit = $ncol+2;
    $groups{$g}->dispose("\$marked_title_$ntit = \"$groups{$g}->{label} (column $nmess)\"");
    $erase .= "erase \$marked_title_$ntit\n"
  };
  $Text::Wrap::huge = 'overflow';
  ## extremely long column label strings can lead to weirdness as the ifeffit
  ## string gets written past the end.  if it's too long, use he alt_label,
  ## which is boring and non-descriptive, but safe
  if (length($label) < 255) {
    $command .= ", label=\"$label\"";
  } else {
    $command .= ", label=\"$alt_label\"";
  };
  $command  = wrap("write_data(", "           ", $command.")");
  ##$command .= ",\n           label=\"$label\")";
  $groups{$current} -> dispose($command, $dmode);
  $groups{$current} -> dispose($erase,   $dmode); # clean up the mess
  $top -> Unbusy;
  Echo("Saving $mess for each marked group ... done!");
};

sub save_each {
  my ($sp) = @_;
  my $m = 0;
  map {$m += $_} values %marked;
  Error("Saving files aborted.  There are no marked groups."), return 1 unless ($m);

  my $d = $top->DialogBox(-title   => "Artemis: Save each marked group to a directory",
			  -buttons => ["Select", "Cancel"],
			  ##-popover => 'cursor'
			 );

  my $curr_dir = $current_data_dir;
  my $label = $d -> add('Label', -textvariable=>\$curr_dir)
    -> pack(-fill => "x", -expand => 1);
  my $fr = $d -> add('Frame') -> pack(-fill => "both", -expand => 1);
  ## ----> need a create new directory button <----
  my $dt = $fr->Scrolled('DirTree',
			 -scrollbars	   => 'osoe',
			 -width		   => 55,
			 -height	   => 20,
			 -selectmode	   => 'browse',
			 -exportselection  => 1,
			 -directory	   => $current_data_dir,
			 -browsecmd	   => sub { $curr_dir = shift },

			 # With this version of -command a double-click will
			 # select the directory
			 ##-command	   => sub { $ok = 1 },

			 # With this version of -command a double-click will
			 # open a directory. Selection is only possible with
			 # the Ok button.
			 #-command	   => sub { $d->opencmd($_[0]) },
			)
    ->pack(-fill => "both", -expand => 1);
  my $this = $d -> Show();
  Echo("Not saving each marked file"), return if ($this eq 'Cancel');

  my $text = q{};
  my @list = (&sorted_group_list);
  foreach my $g (@list) {
    next if not $marked{$g};
    Echonow("Saving $groups{$g}->{label} in \"$curr_dir\" ...");
    $text = save_chi($sp, $g, $curr_dir);
  };
  Echo("Saved $text data to \"$curr_dir\" ...");
};


sub set_defaults {
  my ($group, $space, $is_xmudat) = @_;
 SWITCH:{
    ($space =~ /[aenx]/) and do {
      ## set e0, kmax, Emax values
      if ($is_xmudat) {		# for an xmu.dat file use computed e0
	my @x = Ifeffit::get_array("$group.energy");
	my $omega = $x[0];
	@x = Ifeffit::get_array("$group.e_wrt0");
	$omega -= $x[0];
	$omega += $is_xmudat;
	##print "omega = $omega\n";
	$groups{$group} -> make(bkg_e0=>$omega, bkg_spl1=>0, update_bkg=>1,
				bkg_flatten=>1, bkg_fixstep=>1, bkg_step=>1.0);
      } else {			# else look for max first deriv
	$groups{$group} ->
	  dispose("## need to get e0 to set defaults...\npre_edge(\"$group.energy+$groups{$group}->{bkg_eshift}\", $group.xmu)\n", $dmode);
	my $e0 = Ifeffit::get_scalar("e0");
	unless ($e0) {		# deal with situation where pre_edge
	  $groups{$group} ->	# fails to return an e0 value
	    dispose("## failed to find e0 with the pre_edge command, take max of derivative",
		    $dmode);
	  my $sets = "set($group.derv = deriv($group.xmu)/deriv($group.energy),\n";
	  $sets   .= "    i___i = ceil($group.derv),\n";
	  $sets   .= "    i___i = nofx($group.derv, i___i))\n";
	  $groups{$group} -> dispose($sets, $dmode);
	  $e0 = Ifeffit::get_scalar("i___i");
	  if ($e0 < 5) {
	    $e0 = 15;
	    $groups{$group} -> dispose("## max of derivative was very close to the beginning of the data, e0 set to 15th data point", $dmode);
	  };
	  my @array = Ifeffit::get_array("$group.energy");
	  $e0 = $array[$e0-1];
	  $groups{$group} -> dispose("erase i___i $group.derv", $dmode);
	};
	$groups{$group} -> make(bkg_e0=>$e0);
      };

      ## set defaults of the various range parameters
      my ($pre1, $pre2, $nor1, $nor2, $spl1, $spl2, $kmin, $kmax) =
	set_range_params($group);
      $groups{$group} -> make(
			      bkg_pre1	 => $pre1,
			      bkg_pre2	 => $pre2,
			      bkg_nor1	 => $nor1,
			      bkg_nor2	 => $nor2,
			      bkg_spl1	 => $spl1,
			      bkg_spl2	 => $spl2,
			      bkg_spl1e	 => $groups{$group}->k2e($spl1),
			      bkg_spl2e	 => $groups{$group}->k2e($spl2),
			      fft_kmin	 => $kmin,
			      fft_kmax	 => $kmax,
			      update_bkg => 1,
			     );
      if ($groups{$group}->{is_xmudat}) {
	$groups{$group}->make(bkg_nor2=>$groups{$group}->{bkg_spl2e});
      };
      if ($groups{$group}->{fft_kmax} == 999) {
	if ($groups{$group}->{is_xanes}) {
	  $groups{$group}->make(fft_kmax=>$groups{$group}->e2k($config{xanes}{cutoff}));
	} else {
	  $groups{$group} -> kmax_suggest(\%plot_features);
## 	  if ($groups{$group}->{fft_kmax} < EPSI) {
## 	    $groups{$group} -> dispose("set ___x = ceil($group.k)\n", 1);
## 	    $groups{$group} -> make(fft_kmax=>Ifeffit::get_scalar("___x"));
## 	  };
	};
      };
      last SWITCH;
    };
    ($space eq 'd') and do {
      my @en = Ifeffit::get_array("$group.energy");
      $groups{$group} -> make(bkg_e0=>$en[0]-$plot_features{emin});
      last SWITCH;
    };
    ($space eq 'k') and do {
      $groups{$group}->dispose("___x = ceil($group.k)\n", 1);
      my $maxk = Ifeffit::get_scalar("___x");
      ## need to set fft_kmax correctly
      $groups{$group} -> make(fft_kmax=>$maxk, update_bkg=>0, fft_pc=>'off');
      last SWITCH;
    };
  };
};


sub set_range_params {
  my $group = $_[0];
  ## PRE1
  my @en = Ifeffit::get_array("$group.energy");
  my $firstE  = ($en[1] - $groups{$group}->{bkg_e0});
  my $secondE = ($en[2] - $groups{$group}->{bkg_e0});
  #my $pre1 = $groups{$group}->{bkg_pre1};
  my $pre1 = $groups{$group}->Default('bkg_pre1') || $config{bkg}{pre1};
  ($pre1 *= 1000) if (($pre1 > -1) and ($pre1 < 1));
 PRE1: {
    ($pre1 = $firstE+$pre1), last PRE1 if ($pre1 > 0);
    ($pre1 = $secondE),      last PRE1 if ($pre1 == 0);
    ($pre1 = $secondE),      last PRE1 if ($pre1 < $secondE);
  };

  ## PRE2
  #my $pre2 = $groups{$group}->{bkg_pre2};
  my $pre2 = $groups{$group}->Default('bkg_pre2') || $config{bkg}{pre2};
  ($pre2 *= 1000) if (($pre2 > -1) and ($pre2 < 1));
 PRE2: {
    ($pre2 = $firstE+$pre2), last PRE2 if ($pre2 > 0);
    ($pre2 = $secondE/2),    last PRE2 if ($pre2 < $secondE);
  };
  (($pre1,$pre2) = ($pre2,$pre1)) if ($pre1 > $pre2);
  #($pre2 = ($pre1>30) ? $pre1+30 : $pre1/2) if ($pre1 < $pre2);

  ## NOR1
  my $lastE  = ($en[$#en] - $groups{$group}->{bkg_e0});
  #my $nor1 = $groups{$group}->{bkg_nor1};
  my $nor1 = $groups{$group}->Default('bkg_nor1') || $config{bkg}{nor1};
  ($nor1 *= 1000) if (($nor1 > 0) and ($nor1 < 5));
 NOR1: {
    if ($groups{$group}->{is_xanes}) {
      $nor1 = $config{xanes}{nor1};
      ($nor1 += $lastE) if ($nor1 < 0);
      last NOR1;
    };
    ($nor1 = $lastE/5),     last NOR1 if ($nor1 > $lastE);
    ($nor1 = $lastE+$nor1), last NOR1 if ($nor1 < 0);
  };

  ## NOR2
  my $nor2 = $groups{$group}->Default('bkg_nor2') || $groups{$group}->{bkg_nor2};
  ($nor2 *= 1000) if (($nor2 > -5) and ($nor2 < 5));
 NOR2: {
    if ($groups{$group}->{is_xanes}) {
      $nor2 = $config{xanes}{nor2};
      if    ($nor2 < 0)      { $nor2 += $lastE }
      elsif ($nor2 == 0)     { $nor2  = $lastE }
      elsif ($nor2 > $lastE) { $nor2  = $lastE };
      last NOR2;
    };
    ($nor2 = $lastE),       last NOR2 if ($nor2 > $lastE);
    ($nor2 = $lastE),       last NOR2 if ($nor2 == 0);
    ($nor2 = $lastE+$nor2), last NOR2 if ($nor2 < 0);
  };
  ($nor1 > $nor2) and (($nor1, $nor2) = ($nor2, $nor1));

  ## SPL1
  my $lastk  = $groups{$group}->e2k($lastE);
  my $spl1 = $groups{$group}->Default('bkg_spl1') || $groups{$group}->{bkg_spl1};
 SPL1: {
    ($spl1 = 0.5),          last SPL1 if ($groups{$group}->{is_xanes});
    ($spl1 = 0.5),          last SPL1 if ($spl1 > $lastk);
    ($spl1 = $lastk+$spl1), last SPL1 if ($spl1 < 0);
  };

  ## SPL2
  my $spl2 = $groups{$group}->Default('bkg_spl2') || $groups{$group}->{bkg_spl2};
 SPL2: {
    ($spl2 = $lastk),       last SPL2 if ($groups{$group}->{is_xanes});
    ($spl2 = $lastk),       last SPL2 if ($spl2 > $lastk);
    ($spl2 = $lastk),       last SPL2 if ($spl2 == 0);
    ($spl2 = $lastk+$spl2), last SPL2 if ($spl2 < 0);
  };
  ($spl1 > $spl2) and (($spl1, $spl2) = ($spl1, $lastk));

  ## FFT_KMIN
  my $kmin = $groups{$group}->Default('fft_kmin') || $groups{$group}->{fft_kmin};
 KMIN: {
    ($kmin = 2),            last KMIN if ($groups{$group}->{is_xanes});
    ($kmin = 2),            last KMIN if ($kmin > $lastk);
    ($kmin = $lastk+$kmin), last KMIN if ($kmin < 0);
  };

  ## FFT_KMAX
  my $kmax = $groups{$group}->Default('fft_kmax') || $groups{$group}->{fft_kmax};
 KMAX: {
    ($kmax = $lastk),       last KMAX if ($groups{$group}->{is_xanes});
    ($kmax = 999),          last KMAX if (not $kmax);
    ($kmax = $lastk),       last KMAX if ($kmax > $lastk);
    ($kmax = $lastk+$kmax), last KMAX if ($kmax < 0);
  };
  #($kmax = $lastk) if ($kmax < EPSI);
  ($kmin > $kmax) and (($kmin, $kmax) = ($kmax, $kmin));
  ##print "in set_range: $group $kmax\n";

  ($pre2 = $pre1+5)  if ($pre2 < $pre1);
  ($nor2 = $nor1+50) if ($nor2 < $nor1);
  ($spl2 = $spl1+50) if ($spl2 < $spl1);
  ($kmax = $kmin+5)  if ($kmax < $kmin);
  return ($pre1, $pre2, $nor1, $nor2, $spl1, $spl2, $kmin, $kmax);
};



## first arg is 1 when this is called from the Help menu, 0 otherwise
## second arg is 1 if called after reading a file, 0 otherwise
sub memory_check {
  my ($just_checking, $reading_file) = @_;
  Echo ("Cannot check memory with this version of Ifeffit"), return 0 if ($max_heap == -1);
  my $free = Ifeffit::get_scalar("\&heap_free");
  my $used = $max_heap - $free;
  my $ngr  = keys %groups;
  --$ngr;
  Echo("You have not used any memory yet."), return 0 unless $ngr;
  my $per  = ($ngr) ? $used / $ngr : 0;
  my $more = ($ngr) ? int($free / $per) : 0;
  $per =  int($per/1024);
  $free = int($free/1024);
  $used = int($used/1024);
  my $net = int($max_heap / 1024);
  my $report = "\n\nNumber of groups: $ngr
Memory used per group: $per kB
Memory space used: $used kB
Memory space free: $free kB
Total memory space: $net kB
Approximate number of groups available: $more
";
  if ($just_checking) {
    my $message = "Ifeffit's current memory usage:$report";
    my $dialog =
      $top -> Dialog(-bitmap         => 'info',
		     -text           => $message,
		     -title          => 'Athena: memory check',
		     -buttons        => ['OK'],
		     -default_button => 'OK');
    my $response = $dialog->Show();
    return 0;
  } elsif ($more < 2) {
    my $message = "Ifeffit is nearly out of memory space!!!
Athena will not read more data until you
delete some groups.\n\n$report";
    my $dialog =
      $top -> Dialog(-bitmap         => 'error',
		     -text           => $message,
		     -title          => 'Athena: Out of memory space',
		     -buttons        => ['OK'],
		     -default_button => 'OK');
    my $response = $dialog->Show();
    return -1;
  } elsif (($more < 5) and $reading_file) {
    my $message = "You are running out of Ifeffit memory space!!!
Reading this data group is probably ok, but you
need to delete some groups before reading
more data.\n\n$report";
    my $dialog =
      $top -> Dialog(-bitmap         => 'warning',
		     -text           => $message,
		     -title          => 'Athena: memory space running low',
		     -buttons        => ['OK'],
		     -default_button => 'OK');
    my $response = $dialog->Show();
    return 1;
  } elsif (($more < 10) and (not $reading_file)) {
    my $message = "You are running out of Ifeffit memory space!!!
You should probably delete some groups to
free up space before continuing with any
operation.\n\n$report";
    my $dialog =
      $top -> Dialog(-bitmap         => 'warning',
		     -text           => $message,
		     -title          => 'Athena: memory space running low',
		     -buttons        => ['OK'],
		     -default_button => 'OK');
    my $response = $dialog->Show();
    return 1;
  };
  return 1;
};


sub fetch_url {
  my $remote = "";
  my $label  = "URL of the remote file: ";
  my $dialog = get_string($dmode, $label, \$remote, \@web_buffer);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Aborting web fetch of data."), return unless ($remote);
  Echo("Fetching $remote ...");
  $top -> Busy;
  my @parts = split(/\//, $remote);
  (-d $webdir) or mkpath($webdir);
  my $local = File::Spec->catfile($webdir, $parts[$#parts]);
  my $response = getstore($remote, $local);
  $top -> Unbusy;
  Echo("$remote: HTTP status $response -- " . status_message($response));
  return unless (-e $local);
  push @web_buffer, $remote;
  &read_file(0, $local);
};

sub purge_web_cache {
  return unless -d $webdir;
  opendir C, $webdir;
  map { my $f = File::Spec->catfile($webdir, $_); -f $f and unlink $f}
    (grep !/^\.{1,2}$/, readdir C);
  closedir C;
  Echo("Purged web cache: $webdir");
};


## this wacko sub is to satisfy the Aussie contingent.  The output
## file is something that can be read in by Xfit.  The idea is for
## someone to use Athena for data processing and Xfit for data
## analysis.  Whatever.
sub write_xfit_file {
  Error("Only mu(E) data can be saved as an xfit file."), return unless
    ($groups{$current}->{is_xmu});

  #local $Tk::FBox::a;
  #local $Tk::FBox::b;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [["Xfit data", ".xfit"], ['All', '*']];
  my $initial = join(".", $groups{$current}->{label}, "xfit");
  # spaces are common in filenames on Mac and Win, but not on un*x
  ($initial =~ s/\s+/_/g) unless ($is_windows or $is_darwin);
  ($initial =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$initial,
				 -title => "Athena: Save Xfit data");
  Echo("Saving Xfit data ... canceled", 0), return unless ($file);

  my ($com,$sep) = ("", ",");	 # xfit-able
  #my ($com,$sep) = ("#", "  "); # readable by gnuplot
  #Error("Cannot write to $file"), return unless (-w $file);
  open F, ">".$file;
  ## write boilerplate headers
  printf F ("%sAVERAGE
%s  ABSORBER   %s
%s  EDGE       %s
%s  E0         %.2f eV
%s
",
	    $com,
	    $com, ucfirst(Chemistry::Elements::get_name($groups{$current}->{bkg_z})),
	    $com, $groups{$current}->{fft_edge},
	    $com, $groups{$current}->{bkg_e0},
	    $com
	   );
  printf F ("%sSPLINE
%s  ABSORBER   %s
%s  EDGE       %s
%s  E0         %.2f eV
%s  WEIGHT     K**%.1f
%s  WINDOW     %.2f-%.2f (0.20) angstrom**-1
%s  BACKGROUND
%s  SPLINE
%s  CORRECTION OFF
%s
",
	    $com,
	    $com, ucfirst(Chemistry::Elements::get_name($groups{$current}->{bkg_z})),
	    $com, $groups{$current}->{fft_edge},
	    $com, $groups{$current}->{bkg_e0},
	    $com, $groups{$current}->{bkg_kw},
	    $com, $groups{$current}->{bkg_spl1},
	    $groups{$current}->{bkg_spl2},
	    $com, $com, $com, $com);
  print F $com . "DATA
$com  EV ENERGY
$com  EV X-ray energy in eV
$com  RAW ABSORBANCE
$com  RAW Sample absorbance
$com  FOIL Foil absorbance
$com  BACKGROUND PREEDGE
$com  BACKGROUND Background absorbance
$com  NORMAL Normalised absorbance
$com  SPLINE Polynomial spline
$com  K K-SCALE
$com  K Photoelectron momentum
$com  XAFS EXAFS
$com  XAFS X-ray absorption fine structure
$com
$com EV RAW BACKGROUND NORMAL SPLINE K XAFS
";
  ## columns: energy, mu, pre-edge, norm, normbkg, k, chik
  ## k is converted from E, negative values set to 0
  ## comma separated
  my $gp = $groups{$current}->{group};
  my @e = Ifeffit::get_array("$gp.energy");
  my @x = Ifeffit::get_array("$gp.xmu");
  my @b = Ifeffit::get_array("$gp.bkg");
  my @n = Ifeffit::get_array("$gp.norm");
  my $e0 = $groups{$current}->{bkg_e0};
  foreach my $i (0 .. $#e) {
    my $pre = $groups{$current}->{bkg_int} +
      $groups{$current}->{bkg_slope}*($e[$i] + $groups{$current}->{bkg_eshift});
    my $normbkg = ($b[$i] - $pre)/$groups{$current}->{bkg_step};
    my $k = ($e[$i] < $e0) ? "0" : sprintf("%.5f",sqrt(ETOK * ($e[$i]-$e0)));
    my $chik = $n[$i] - $normbkg;
    printf F " %.5f%s%.11f%s%.11f%s%.11f%s%.11f%s%s%s%.11f\n",
      $e[$i], $sep, $x[$i], $sep, $pre, $sep, $n[$i], $sep,
	$normbkg, $sep, $k, $sep, $chik;
  };

  close F;
  Echo("Wrote $groups{$current}->{label} to an Xfit file.");
};




## END OF DATA INPUT SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  groups operations and accounting and with displaying a newly
##  selected group


## merge all marked groups by simple averaging, take care to do the
## "right" thing for different spaces
sub merge_groups {
  my $space = lc($_[0]);
  my $doing_refs = $_[1] || 0;
  my $m = 0;
  my $curr = $current;
  my $all_ref = 1;
  map {$m += $_} values %marked;
  Error("Merging aborted.  There are no marked groups."),   return 1 unless ($m);
  Error("Merging aborted.  There is just 1 marked group."), return 1 if ($m==1);
  my $sp;
 SPACE: {
    ($sp = "energy"),  last SPACE if ($space eq 'e');
    ($sp = "energy (normalized)"),  last SPACE if ($space eq 'n');
    ($sp = "k-space"), last SPACE if ($space eq 'k');
    ($sp = "R-space"), last SPACE if ($space eq 'r');
    ($sp = "q-space"), last SPACE if ($space eq 'q');
  };
  Echo("Merging marked groups in $sp");
  $top -> Busy(-recurse=>1,);
  my ($group, $label) = group_name("merge");
  ($label = "  Ref ".$groups{$doing_refs}->{label}) if $doing_refs;
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  my ($file, $first, $is_detector, $is_xanes) =
    $groups{$group}->merge($space, $config{merge}{merge_weight}, $dmode, \%groups, \%marked, \%plot_features, $list);
  $groups{$group} -> make(file=>$file, is_xanes=>$is_xanes);
  # make parameters same as the first in the merge list
  $groups{$group} -> set_to_another($groups{$first});
  $groups{$group} -> make(bkg_z    => $groups{$first}->{bkg_z},
			  fft_edge => $groups{$first}->{fft_edge});
  # because a merged group is a merge of data that has been e0
  # shifted, the merge must NOT be e0 shifted.
  $groups{$group} -> {bkg_eshift} = 0;
 SWITCH: {
    ($space eq 'e') and do {
      $groups{$group} -> make(is_xmu=>1, is_chi=>0, is_rsp=>0, is_qsp=>0, update_bkg=>1);
      $groups{$group} -> make(is_xmu=>0, not_data=>1) if $is_detector;
      last SWITCH;
    };
    ($space eq 'n') and do {
      $groups{$group} -> make(is_xmu=>1, is_chi=>0, is_rsp=>0, is_qsp=>0, is_nor=>1,
			      update_bkg=>1, bkg_slope=>0, bkg_int=>0, bkg_step=>1,
			      bkg_fixstep=>1, bkg_fitted_step=>1);
      $groups{$group} -> make(is_xmu=>0, is_nor=>0, not_data=>1) if $is_detector;
      last SWITCH;
    };
    ($space eq 'k') and do {
      $groups{$group} -> dispose("set(___x = ceil($group.k))\n", 1);
      my $maxk = Ifeffit::get_scalar("___x");
      $groups{$group} -> make(is_xmu=>0, is_chi=>1, is_rsp=>0, is_qsp=>0, update_fft=>1,
			      update_bkg=>0, fft_kmax=>sprintf("%.2f", $maxk));
      last SWITCH;
    };
    ($space eq 'r') and do {
      $groups{$group} -> make(is_xmu=>0, is_chi=>0, is_rsp=>1, is_qsp=>0,
			      update_bft=>1, update_fft=>0, update_bkg=>0);
      last SWITCH;
    };
    ($space eq 'q') and do {
      $groups{$group} -> make(is_xmu=>0, is_chi=>0, is_rsp=>0, is_qsp=>1,
			      update_bft=>0, update_fft=>0, update_bkg=>0);
      last SWITCH;
    };
  };
  ++$line_count;
  $groups{$group} -> make(line=>$line_count);
  if ($sp eq 'energy') {
    $groups{$group} -> make(bkg_spl1=>$groups{$curr}->{bkg_spl1},
			    bkg_spl2=>$groups{$curr}->{bkg_spl2});
    # do not reset e0!!!
  };
  fill_skinny($list, $group, 1);

  ## merge reference spectra if all groups in the merge have references
  if ($space =~ m{[en]}) {
    if (not $doing_refs) {
      foreach my $m (keys %marked) {
	next if not $marked{$m};
	my $has_ref = $groups{$m}->{reference};
	$all_ref = ($all_ref and $has_ref);
	#print $groups{$m}->{label}, "  $all_ref $has_ref\n";
      };
      if ($all_ref) {
	my $ref_group = merge_refs($space, $group);
	$groups{$group}->{reference} = $ref_group;
	$groups{$ref_group}->{reference} = $group;
      };
      set_properties(1, $group, 0);
    };
  };
  return $group if $doing_refs;

  $marked{$group} = 1;
  ($space = "d") if $is_detector;
  plot_merge($group, $space);

  Echo("Merging marked groups in $sp ... done!");
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
  $top->Unbusy;
  return $group;
};


sub merge_refs {
  my ($space, $gp) = @_;
  my @list = ();
  ## set the marks to the reference channels
  foreach my $m (keys %marked) {
    push @list, $groups{$m}->{reference} if $marked{$m};;
    $marked{$m} = 0;
  };
  map { $marked{$_}=1 } @list;

  my $ref_group = merge_groups($space, $gp);

  ## set the marks back to the data
  @list = ();
  foreach my $m (keys %marked) {
    push @list, $groups{$m}->{reference} if $marked{$m};;
    $marked{$m} = 0;
  };
  map { $marked{$_}=1 } @list;
  $top->update;
  return $ref_group;
};



## generate a copy of the current group with a unique name
sub copy_group {
  Echo('No data!'), return unless ($current);
  Echo("Cannot copy defaults."), return if ($current eq "Default Parameters");
  my ($group, $label) = group_name("Copy of " . $groups{$current}->{label});
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  $groups{$group} -> set_to_another($groups{$current});
  $groups{$group} -> make(is_xmu   => $groups{$current}->{is_xmu},
			  is_chi   => $groups{$current}->{is_chi},
			  is_rsp   => $groups{$current}->{is_rsp},
			  is_qsp   => $groups{$current}->{is_qsp},
			  is_nor   => $groups{$current}->{is_nor},
			  is_bkg   => $groups{$current}->{is_bkg},
			  is_diff  => $groups{$current}->{is_diff},
			  is_pixel => $groups{$current}->{is_pixel},
			  is_xanes => $groups{$current}->{is_xanes},
			  not_data => $groups{$current}->{not_data},
			 );
  $groups{$group} -> make(file=>$groups{$current}->{file}, update_bkg=>1);
  my $mark = $marked{$current};
  my $original = $current;
 SWITCH: {			# handle each space appropriately
    (($groups{$group}->{is_xmu}) or ($groups{$group}->{is_chi})) and do {
      my $xsuff = ($groups{$group}->{is_xmu}) ? ".energy" : ".k";
      my $ysuff = ($groups{$group}->{is_xmu}) ? ".xmu"    : ".chi";
      my @x = Ifeffit::get_array($current.$xsuff);
      my @y = Ifeffit::get_array($current.$ysuff);
      Ifeffit::put_array($group.$xsuff, \@x);
      Ifeffit::put_array($group.$ysuff, \@y);
      if ($groups{$current}->{i0}) {
	$groups{$group} -> make(i0 => "$group.i0");
	my @i0 = Ifeffit::get_array($current.$ysuff);
	Ifeffit::put_array("$group.i0", \@i0);
      };
      last SWITCH;
    };
    ($groups{$group}->{not_data}) and do {
      my $xsuff = ".energy";
      my $ysuff = ".det";
      my @x = Ifeffit::get_array($current.$xsuff);
      my @y = Ifeffit::get_array($current.$ysuff);
      Ifeffit::put_array($group.$xsuff, \@x);
      Ifeffit::put_array($group.$ysuff, \@y);
      last SWITCH;
    };
    (($groups{$group}->{is_rsp}) or ($groups{$group}->{is_qsp})) and do {
      my $x = ($groups{$group}->{is_rsp}) ? 'r' : 'q';
      my @x = Ifeffit::get_array($current.".$x");
      Ifeffit::put_array($group.".$x", \@x);
      foreach (qw(mag pha re im)) { # copy all four arrays
	my $suff = join("", ".chi", $x, "_", $_);
	my @y = Ifeffit::get_array($current.$suff);
	Ifeffit::put_array($group.$suff, \@y);
      };
      last SWITCH;
    };
  };
  ++$line_count;
  $groups{$group} -> make(line=>$line_count);
  fill_skinny($list, $group, 1, 1);
  $marked{$group} = $mark;
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
  return $group;
};


## This makes detector groups out of the numerator and denominator of
## an xmu group
sub make_detectors {
  my $group	  = $groups{$current}->{group};
  my $label	  = $groups{$current}->{label};
  my $e0	  = $groups{$current}->{bkg_e0};
  my $esh	  = $groups{$current}->{bkg_eshift};
  my $numerator	  = $groups{$current}->{numerator};
  my $denominator = $groups{$current}->{denominator};
  my @dets        = ();

  if ($numerator !~ /^\s*$/) {
    my ($num_group, $num_label) = group_name("num $label");
    $groups{$num_group} = Ifeffit::Group -> new(group=>$num_group, label=>$num_label);
    $groups{$num_group} -> make(is_xmu => 0, is_chi => 0, is_rsp => 0, is_qsp => 0,
				not_data => 1, bkg_e0 => $e0, bkg_eshift => $esh,
				file => "Numerator of $label");
    my $sets = "set($num_group.energy = $group.energy,\n";
    $sets   .= "    $num_group.det = $numerator,\n";
    $sets   .= "    ___ceil = ceil($num_group.det))";
    $groups{$num_group} -> dispose($sets, $dmode);
    my $scale = sprintf("%8.2e", 1/Ifeffit::get_scalar("___ceil"));
    ++$line_count;
    set_defaults($num_group, 'e', 0);
    $groups{$num_group} -> make(line=>$line_count, plot_scale=>sprintf("%f",$scale));
    fill_skinny($list, $num_group, 1);
    push @dets, $num_group;
  };
  if ($denominator !~ /^\s*$/) {
    my ($den_group, $den_label) = group_name("den $label");
    $groups{$den_group} = Ifeffit::Group -> new(group=>$den_group, label=>$den_label);
    $groups{$den_group} -> make(is_xmu => 0, is_chi => 0, is_rsp => 0, is_qsp => 0,
				not_data => 1, bkg_e0 => $e0, bkg_eshift => $esh,
				file => "Denominator of $label");
    my $sets = "set($den_group.energy = $group.energy,\n";
    $sets   .= "    $den_group.det = $denominator,\n";
    $sets   .= "    ___ceil = ceil($den_group.det))";
    $groups{$den_group} -> dispose($sets, $dmode);
    my $scale = sprintf("%8.2e", 1/Ifeffit::get_scalar("___ceil"));
    ++$line_count;
    set_defaults($den_group, 'e', 0);
    $groups{$den_group} -> make(line=>$line_count, plot_scale=>sprintf("%f",$scale));
    fill_skinny($list, $den_group, 1);
    push @dets, $den_group;
  };

  set_properties(1, $group, 0);
  $groups{$current}->make(detectors=>\@dets);
  my $memory_ok = $groups{$current}->memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};


## turn the background function for a group into it's own group so it
## can be displayed independently of its data.
sub make_background {
  my $group = $groups{$current}->{group};
  my $e0    = $groups{$current}->{bkg_e0};
  my $esh   = $groups{$current}->{bkg_eshift};
  my $step  = $groups{$current}->{bkg_step};
  ($groups{$current}->{update_bkg}) and $groups{$current}->dispatch_bkg($dmode);
  my ($bkg, $label) = group_name($groups{$current}->{label}." bkg");
  $groups{$bkg} = Ifeffit::Group -> new(group=>$bkg, label=>$label);
  $groups{$bkg} -> set_to_another($groups{$group});
  $groups{$bkg} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0, is_qsp => 0, is_bkg => 1,
			not_data => 0,
			file=>"Background from ".$groups{$current}->{label});
  #, bkg_e0 => $e0, bkg_eshift => $esh, bkg_step => $step);
  my $cmd = "set($bkg.energy = $group.energy,\n";
  if ($groups{$group}->{bkg_cl}) {
    $cmd .= "    $bkg.xmu = $group.f2)";
  } else {
    $cmd .= "    $bkg.xmu = $group.bkg)";
  };
  $groups{$bkg} -> dispose($cmd, $dmode);
  ++$line_count;
  fill_skinny($list, $bkg, 1);
  $groups{$bkg} -> plotE('em',$dmode,\%plot_features, \@indicator);
  my $memory_ok = $groups{$bkg} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};


## read a string from an entry box that temporarily replaces the echo
## area.  $label is the descriptive label to be written before the
## entry box.  $r_string is a ref to the string being prompted for.
## $r_arrow_buffer is a ref to a array containing a buffer of
## responses accessed via the up and down arrows
sub get_string {
  my ($mode, $label, $r_string, $r_arrow_buffer) = @_;
  $top -> packPropagate(0);
  $echo -> packForget;
  my $prior = $top -> focusCurrent;
  my $ren = $ebar -> Frame()
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -ipadx=>3);
  $ren -> Label(-text=>$label,
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  my $entry = $ren -> Entry(-justify=>'center', -background=>$config{colors}{current},
			    -textvariable=>$r_string)
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>10);
  if ($r_arrow_buffer) {
    my $pointer = $#{$r_arrow_buffer} + 1;
    $entry->bind("<KeyPress-Up>",	# previous command in history
		 sub{ --$pointer; ($pointer=0) if ($pointer<0);
		      $entry->delete(0,'end');
		      $entry->insert(0, $$r_arrow_buffer[$pointer]); });
    $entry->bind("<KeyPress-Down>", # next command in history
		 sub{ ++$pointer; ($pointer= $#{$r_arrow_buffer}) if
			($pointer>$#{$r_arrow_buffer});
		      $entry->delete(0,'end');
		      $entry->insert(0, $$r_arrow_buffer[$pointer]); });
  };
  my $pad = 0;
  $entry -> bind("<KeyPress-Return>", sub{&restore_echo($ren, $mode, $entry, $prior)});
  $ren -> Button(-text=>'OK',  @button_list, -font=>$config{fonts}{small}, -borderwidth=>1,
		 -command=>[\&restore_echo, $ren, $mode, $entry, $prior])
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  foreach ($ren, $entry) {
    my $this = $_;
    $this -> bindtags([($this->bindtags)[1,0,2,3]]);
    map {$this -> bind("<Control-$_>" => sub{$this->break;})}
      qw(a b h i f j k l m o p r s t u w y
	 period slash minus equal semicolon
	 Key-1 Key-2 Key-3 Key-4 Key-5 Key-6);
    map {$this -> bind("<Alt-$_>" => sub{$this->break;});
	 $this -> bind("<Meta-$_>" => sub{$this->break;});}
      qw(b B j k o d semicolon);
  };

  $entry -> selectionRange(qw(0 end));
  $entry -> icursor('end');
  $top   -> update;
  $ren   -> grab();
  $entry -> focus;
  return $ren;
};


## destroy the get_string dialog and return the echo area
sub restore_echo {
  my ($ren, $mode, $entry, $prior) = @_;
  $ren -> grabRelease;
  $ren -> packForget;
  $ren -> destroy;
  $ebar -> pack(-side=>"bottom", -fill=>'x');
  $echo -> pack(-side=>'left', -expand=>1, -fill=>'x', -pady=>2);
  if ($prior) { # and $prior->packInfo()) {
    $prior -> focus;
  } else {
    $b_red{E} -> focus;
  };
};



## pop up a top level asking the user to provide a string as the new
## name for a group.  then call rename_group.
sub get_new_name {
  Echo('No data!'), return unless ($current);
  Echo("You cannot rename the defaults"),
    return if ($current eq "Default Parameters");
  my $newname = $groups{$current}->{label};
  my $label = "New name for group \"" . $groups{$current}->{label} . "\": ";
  my $dialog = get_string($dmode, $label, \$newname, \@rename_history);

  my @list = &sorted_group_list;
  my $l = $#list+1;
  my $h = -1;
  foreach (@list) {
    ++$h;
    last if ($_ eq $current);
  };
  ($h -= 2) if ($h > 1);
  $list -> yview('moveto', $h/$l);

  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  rename_group($dmode, $newname);
};




## rename a group -- actually just reset its label and display the new
## label in the skinny panel
sub rename_group {
  my ($mode, $newname, $which) = @_;
  $which ||= $current;
  Echo("Not renaming '$groups{$which}->{label}'", 0), return if ($newname =~ /^\s*$/);
  Echo("Not renaming '$groups{$which}->{label}'", 0), return if ($newname eq $groups{$which}->{label});
  my $oldname = $groups{$which}->{label};
  Echo("Renaming \"$oldname\" to \"$newname\"");
  push @rename_history, $newname;
  my $quote_message = q{};
  if ($newname =~ m{[\"\']}) {
    $newname =~ s{[\"\']}{}g;
    $quote_message = " (quote marks removed from group name)";
  };
  ## need to verify that this name is not already used
  $groups{$which} -> MAKE(label=>$newname);
  ## fix up the skinny panel entry
  my $tag = $groups{$which}->{bindtag};
  my @bold   = (-fill => $config{colors}{activehighlightcolor},
		#-font => $config{fonts}{large},
	       );
  my @normal = (-fill => $config{colors}{foreground},
		#-font => $config{fonts}{med},
	       );
  my @rect_in  = (-fill => $config{colors}{activebackground}, -outline=>$config{colors}{activebackground});
  my @rect_out = (-fill => $config{colors}{background},       -outline=>$config{colors}{background});
  $list -> bind($tag, '<1>' => [\&set_properties, $which, 0]);
  $list -> bind($tag, '<3>' => [\&GroupsPopupMenu, $which, Ev('X'), Ev('Y')]);
  ## change text size/color unless passing over the current group
  $list -> bind($tag, '<Any-Enter>'=>sub{my $this = shift;
					 return if not exists($groups{$which}->{bindtag});
					 if ($this->itemcget('current', '-tags')->[0] ne $groups{$which}->{bindtag}) {
					   #$this->itemconfigure('current', @bold  );
					   my $x = $this->find(below=>'current');
					   $this->itemconfigure($x, @rect_in,);
					 }
				       });
  $list -> bind($tag, '<Any-Leave>'=>\&Leave);
  $list -> itemconfigure($groups{$which}->{text}, -text=>$newname, -tag=>$tag);
  $groups{$which}->{checkbutton} -> configure(-variable=>\$marked{$which});
  $list -> coords($groups{$which}->{rect}, $list->bbox($groups{$which}->{text}));
  ## deal with reference channel
  my $ref = $groups{$which}->{reference};
  if ($ref                            and
      #not $groups{$which}->{is_ref} and
      ($groups{$ref}->{label} =~ m{^ *Ref +$oldname$})) {
    $groups{$ref} -> MAKE(label=>"   Ref " . $newname);
    my $tag = $groups{$ref}->{bindtag};
    $list -> bind($tag, '<1>' => [\&set_properties, $ref, 0]);
    $list -> bind($tag, '<3>' => [\&GroupsPopupMenu, $ref, Ev('X'), Ev('Y')]);
    ## change text size/color unless passing over the reference group
    $list -> bind($tag, '<Any-Enter>'=>sub{my $this = shift;
					   #print join(" ", $this->itemcget('current', '-tags')), $/;
					   #print ">>>", $groups{$ref}->{bindtag}, $/;
					   if ($this->itemcget('current', '-tags')->[0] ne $groups{$which}->{bindtag}) {
					     my $x = $this->find(below=>'current');
					     $this->itemconfigure($x, @rect_in  )
					   };
					 });
    $list -> bind($tag, '<Any-Leave>'=>\&Leave);
    ##$list -> bind($tag, '<Any-Leave>'=>sub{shift->itemconfigure('current', @normal)});
    $list -> itemconfigure($groups{$ref}->{text}, -text=>$groups{$ref}->{label}, -tag=>$tag);
    $list -> coords($groups{$ref}->{rect}, $list->bbox($groups{$ref}->{text}));
  };
  set_properties(1, $which, 0);
  project_state(0);
  Echo("\"$oldname\" renamed to \"$newname\" $quote_message");
};


sub mark {
  my $how = $_[0];
 SWITCH: {
    ($how eq 'all') and do {
      map {$marked{$_} = 1} keys %marked;
      last SWITCH;
    };
    ($how eq 'none') and do {
      map {$marked{$_} = 0} keys %marked;
      last SWITCH;
    };
    ($how eq 'toggle') and do {
      map {$marked{$_} = !$marked{$_}} keys %marked;
      last SWITCH;
    };
    ($how eq 'this') and do {
      $marked{$current} = !$marked{$current};
      last SWITCH;
    };
    ($how eq 'regex') and do {
      mark_regex(1);
      last SWITCH;
    };
    ($how eq 'unregex') and do {
      mark_regex(0);
      last SWITCH;
    };
  };
};

sub mark_regex {
  my $mark = $_[0];
  my $regex = "";
  my $label = $mark ? "Mark" : "Unmark";
  $label   .= " all groups matching this perl regular expression: ";
  my $dialog = get_string($dmode, $label, \$regex, \@regex_history);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Aborting regex matching."), return if ($regex =~ /^\s*$/);
  my $given = $regex;
  my $re;
  if ($config{general}{match_as} eq 'perl') {
    my $is_ok = eval '$re = qr/$regex/i';
    Error("Oops!  \"$regex\" is not a valid regular expression"), return unless $is_ok;
  } else {
    $regex = glob_to_regex($given);
  };
  ##map {$marked{$_} = ($groups{$_}->{label} =~ /$regex/) ? 1 : 0} keys %marked;
  foreach my $k (keys %marked) {
    next unless ($groups{$k}->{label} =~ /$regex/);
    $marked{$k} = $mark;
  };
  push @regex_history, $given;
  my $what = $mark ? "Marked" : "Unmarked";
  Echo("$what all groups matching /$given/");
};


## reordering the groups list...
sub group_up   { group_move(-1); };
sub group_down { group_move(1);  };
sub group_move {
  my $dir = $_[0];
  my @keys = &sorted_group_list;
  Error("There aren't any groups!"), return unless (@keys);
  my $index = -1;
  foreach (@keys) {
    ++$index;
    last if ($_ eq $current);
  };
  Echo("$groups{$current}->{label} is at the top of the list"),    return if (($dir < 0) and ($index == 0));
  Echo("$groups{$current}->{label} is at the bottom of the list"), return if (($dir > 0) and ($index == $#keys));

  $index += $dir;
  my $other = $keys[$index];
  my $step = $config{list}{real_y};		# see $step in fill_skinny
  ## swap $current with the one above/below
  foreach ($current, $other) {
    my $dist = sprintf("%fc", ($_ eq $current) ? $dir*$step : -1*$dir*$step);
    my ($check, $text, $rect) = ($groups{$_}->{check}, $groups{$_}->{text},
				 $groups{$_}->{rect});
    $list->move($check, 0, $dist);
    $list->move($text,  0, $dist);
    $list->move($rect,  0, $dist);
  };

  # finally adjust the view
  my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
  ($here < 0) and ($here = 0);
  my $full = ($list->bbox(@skinny_list))[3] + 5;
  $list -> yview('moveto', $here/$full);
  project_state(0);
};


sub current_up   { &current_move(-1); };
sub current_down { &current_move(1);  };
sub current_move {
  my $dir = $_[0];
  my @keys = &sorted_group_list;
  Error("There aren't any groups!"), return unless (@keys);
  my $index = -1;
  foreach (@keys) {
    ++$index;
    last if ($_ eq $current);
  };
  Echo("$groups{$current}->{label} is at the top of the list"),    return if (($dir < 0) and ($index == 0));
  Echo("$groups{$current}->{label} is at the bottom of the list"), return if (($dir > 0) and ($index == $#keys));
  set_properties(1, $keys[$index+$dir], 0);
  # finally adjust the view
  my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
  ($here < 0) and ($here = 0);
  my $full = ($list->bbox(@skinny_list))[3] + 5;
  $list -> yview('moveto', $here/$full);
  ##project_state(0);
};


## get rid of the current group both in the GUI and in ifeffit
sub delete_group {
  #Error("You can only delete groups in the normal view."), return unless ($fat_showing eq 'normal');
  my $debug = 0;
  Echo('No data!'), return unless ($current);
  my ($c, $mode, $which) = @_;
  Echo("Cannot delete defaults."), return if ($current eq "Default Parameters");
  my $to_delete = $which || $current;
  my $group = $groups{$to_delete}->{group};
  my $label = $groups{$to_delete}->{label};
  print "Discarding $to_delete ($label)\n" if $debug;
  my $message = "Group \"$label\" removed from project.";
  Echonow("Removing group \"$label\" from project");
  ## what about title lines

  ## clear referent if this is a reference
  if ($groups{$to_delete}->{reference}) {
    if (exists($groups{$groups{$to_delete}->{reference}})) {
      Echonow("Untying referent \"" . $groups{$groups{$to_delete}->{reference}}->{label} . "\"");
      $groups{$groups{$to_delete}->{reference}}->MAKE(reference=>0);
    };
  };

  my @keys = &sorted_group_list;
  print "\tDisposing erase command to ifeffit\n" if $debug;
  $groups{$to_delete} -> dispose("erase \@group $group\n", $mode);
  print "\tRemoving widgets from groups list\n" if $debug;
  $c->delete($groups{$to_delete}->{check});
  $c->delete($groups{$to_delete}->{rect});
  $c->delete($groups{$to_delete}->{text});
  --$line_count;
  print "\tDeleting groups and marked hash entries\n" if $debug;
  delete $marked{$to_delete};
  delete $groups{$to_delete};
  $to_delete = "";
  my $prev = "Default Parameters";
  print "\tFinding location in groups list\n" if $debug;
  while (@keys) {
    my $this = shift @keys;
    last if ($this eq $group);
    $prev = $this;
  };
  print "\tSetting properties of newly selected group\n" if $debug;
  my $step = '-' . $config{list}{real_y} . 'c';		# see $step in fill_skinny
  print "\tMoving widgets of newly selected group\n" if $debug;
  foreach (@keys) {		# list only contains those below deleted group
    my ($check, $text, $rect) = ($groups{$_}->{check}, $groups{$_}->{text},
				 $groups{$_}->{rect});
    $c->move($check, 0, $step);
    $c->move($text,  0, $step);
    $c->move($rect,  0, $step);
  };

  my $h = ($list->bbox(@skinny_list))[3]  || 0;
  $h += 5;
  ($h < 200) and ($h = 200);
  $list -> configure(-scrollregion=>['0', '0', '150', $h]);
  unless ($which) {
    set_properties(1, "Default Parameters", 0), Echo($message), return "Default Parameters" unless $prev;
    set_properties(1, $prev, 0), Echo($message), return $prev unless @keys;
    set_properties(1, $keys[0], 0);
  };

  print "\tAlmost done\n" if $debug;
  project_state(0);
  Echonow("Group \"$label\" removed from project.");
  print "\tDone!\n" if $debug;
  return $prev;
};

## delete every group in the skinny canvas if the third arg is false
## delete only marked groups is the third arg is true
sub delete_many {
  #Error("You can only delete groups in the normal view."), return unless ($fat_showing eq 'normal');
  Echo('No data!'), return unless ($current);
  my ($c, $mode, $m) = @_;
  unless ($m) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "Save this project before closing?.",
		     -title          => 'Athena: Question...',
		     -buttons        => ['Save', 'Just close it', 'Cancel'],
		     -default_button => 'Save');
    my $response = $dialog->Show();
    return if $response eq 'Cancel';
    &save_project('all') if $response eq 'Save';
  };
  my $str = ($m) ? "Removing marked groups from project" : "Closing entire project";
  if ((not $m) and ($groups{"Default Parameters"} -> vstr($ifeffit_version) > 1.02008)) {
    $groups{"Default Parameters"} -> dispose("reset", $dmode);
    $groups{"Default Parameters"} -> dispose("set \&screen_echo = 0", $dmode);
    $groups{"Default Parameters"} -> dispose(&write_macros, $dmode);
    $groups{"Default Parameters"} -> dispose("startup", $dmode);
    #$ENV{PGPLOT_DIR} ||= '/usr/local/share/pgplot';
    #$ENV{PGPLOT_DEV} ||= '/XSERVE';
    #Ifeffit::Tools::reload("Ifeffit");
    #ifeffit("\&screen_echo = 0\n");
  };
  Echo($str);
  $top -> Busy(-recurse=>1,);
  my @keys = &sorted_group_list;
  my $show = "";
  my $sync = Ifeffit::get_scalar('&sync_level');
  ##$groups{"Default Parameters"} -> dispose('&sync_level = 0', $dmode);
  my $save_groupreplot = $config{general}{groupreplot};
  $config{general}{groupreplot} = 'none';
  while (@keys) {
    my $this = pop @keys;
    next if ($m and not $marked{$this});
    $show = delete_group($c, $mode, $this);
  };
  ##$groups{"Default Parameters"} -> dispose("\&sync_level = $sync\nsync()\n", $dmode);
  @keys = &sorted_group_list;
  $show = $keys[0] if (($show eq "Default Parameters") and @keys);

  $config{general}{groupreplot} = $save_groupreplot;
  ## there is a bug somewhere just prior to this and elements of
  ## %group are being vivified but not blessed.  this will remove
  ## those naughty hash pairs
  foreach my $g (keys %groups) {
    delete($groups{$g}) unless ref($groups{$g}) =~ /Ifeffit/;
  };
  ($m) or $notes{journal} -> delete(qw(1.0 end));

  my $h = ($list->bbox(@skinny_list))[3]  || 0;
  $h += 5;
  ($h < 200) and ($h = 200);
  $list -> configure(-scrollregion=>['0', '0', '150', $h]);

  $str .= " ... done!";
  ## unset this in deleting entire project
  ($project_name = "") unless $m;
  $plot_features{project} = $project_name;
  project_state(0);
  Echo($str);
  $top->update;
  ($m) ? set_properties(0, $show, 0) : set_properties(1, $show, 0);
  $top->Unbusy;
};



sub kw_button {
  foreach my $g (keys %marked) {
    $groups{$g}->MAKE(update_fft=>1);
  };
  if ($last_plot =~ /k/) {
    $last_plot_params->[3] = $plot_features{kw};
  };
  #$last_plot_params = [$current, 'marked', 'k', $str];
  if ($last_plot eq 'kq') {
    $b_red{kq}->invoke;
  } elsif ($last_plot eq 'e') {
    1; # do nothing
  } else {
    redo_plot();
  };
  section_indicators();
  $plot_features{k_w} = $plot_features{kw};
};


sub refresh_titles {
  my $self = $_[0];
  return unless (ref $self =~ /Ifeffit/);
  $self->{titles} = [];
  my $text = $notes{titles} -> get(qw(1.0 end));
  my @titles = ();
  foreach (split(/\n/, $text)) {
    next if ($_ =~ /^\s*$/);
    ## walk through the title line counting open and closed parens,
    ## skipping unmatched close parens
    my $count = 0;
    foreach my $i (0..length($_)) {
      ++$count if (substr($_, $i, 1) eq '(');
      --$count if ($count and (substr($_, $i, 1) eq ')'));
    };
    ## close all unmatched parens by appending close_parens to the string
    $_ .= ')' x $count;

    ## remove all parens
    ## $_ =~ s/[\(\)]//g;

    ## ! % and # in title lines seem to be a problem on Windows
    $_ =~ s/[!\%\#]//g;

    ## remove all unmatched open parens -- fragile!!
    ## while (/\([^\)]*$/) {
    ##   $_ =~ s/\(//;
    ## };

    push @titles, $_;
  };
  $self -> MAKE(titles=>\@titles);
  $self -> put_titles;
};

## This updates the current group in ways that aren't handled by other
## mechanisms
sub update_hook {
  my $this = $_[0] || $current;

  ## fixed step may not be up to date if the fixstep button was
  ## pressed, then the step size was edited
  $groups{$this} -> make(bkg_step => $widget{bkg_step}->cget('-value')) if $groups{$this}->{bkg_fixstep};
};


sub group_name {
  #my $this = lc($_[0]);
  my $this = $_[0];
  $this =~ s/[^A-Za-z0-9_&. ]/_/g;

  ## want to generate a unique label
  my $label = $this;
  my $found = 0;
  foreach my $g (keys %groups) {
    next unless exists $groups{$g};
    next unless exists $groups{$g}->{label};
    $found = 1 if ($label eq $groups{$g}->{label});
  };
  my $count = 2;
  while ($found) {
    $label = $this . " $count";
    $found = 0;
    foreach my $g (keys %groups) {
      next unless exists $groups{$g};
      next unless exists $groups{$g}->{label};
      $found = 1 if ($label eq $groups{$g}->{label});
    };
    ++$count;
  };

  my $gp = four_character_random_string();
  while (exists $groups{$gp}) {	# make sure to get a unique one!
    $gp = four_character_random_string();
  };
  $label =~ s{[\"\']}{}g;
  $label =~ s{^unmacify_}{};
  return ($gp, $label);
};


## 4 char keyspace is almost 1/2 million large
##  26^3 =     17576
##  26^4 =    456976
##  26^5 =  11881376
##  26^6 = 308915776
sub four_character_random_string {
  return chr(97 + int(rand(26))) . chr(97 + int(rand(26))) .
      chr(97 + int(rand(26))) . chr(97 + int(rand(26)));
};



sub set_edge {
  my $this = $_[0];
  my $how   = $_[1];
  ($how = "fraction") if ($how eq "half");
  my $message = "";
  Echo("No data"), return unless ($this);
  Echo("The group \"$groups{$this}->{label}\" is frozen."), return if ($groups{$this}->{frozen});
  return unless $groups{$this}->{is_xmu};

 SWITCH: {
    # ifeffit's e0 (near peak of 1st derivative)
    ($how eq 'edge') and do {
      $groups{$this}->reset_e0($dmode);
      $message = "E0 set to Ifeffit's default (near the peak of the 1st derivative) for \"$groups{$this}->{label}\"";
      last SWITCH;
    };

    # zero-crossing nearest to ifeffit's e0
    ($how eq 'zero') and do {
      my %params = (e0 => $groups{$this}->{bkg_e0}, str =>'em2', zero_skip_plot => 1);
      cal_zero($this, \%params);
      $groups{$this}->make(bkg_e0=>$params{e0}, update_bkg=>1);
      $message = "E0 set to zero-crossing of second derivative for \"$groups{$this}->{label}\"";
      last SWITCH;
    };

    # energy of the half edge step
    ($how eq 'fraction') and do {
      $top->Busy;
      $groups{$this}->e0_half_step($dmode, $config{bkg}{fraction});
      $top->Unbusy;
      $message = "E0 set to a fraction of the edge step for \"$groups{$this}->{label}\"";
      last SWITCH;
    };

    # tabulated atomic value
    ($how eq 'atomic') and do {
      Echo("Cannot fetch atomic e0 values."), return unless $absorption_exists;
      my ($z, $edge) = ($groups{$this}->{bkg_z}, $groups{$this}->{fft_edge});
      my $en = Xray::Absorption->get_energy($z, $edge);
      $groups{$this}->make(bkg_e0=>$en, update_bkg=>1);
      $message = sprintf("E0 set to the atomic value for the %s edge of %s for \"$groups{$this}->{label}\"", $edge, $z);
      last SWITCH;
    };

  };

  project_state(0);
  set_properties(1, $this, 0);
  #autoreplot('e');
  Echo($message)
};

sub set_edges {
  my ($how, $which) = @_;
  my $remember = $current;
  my @list = &sorted_group_list;
  foreach my $g (@list) {
    next if (($which eq 'marked') and (not $marked{$g}));
    if ($how eq "peak") {
      set_edge_peak($g);
      next;
    };
    set_edge($g, $how);
  };
  my $descr = "Ifeffit's default";
  $descr = "zero-crossing of second derivative" if ($how eq 'zero');
  $descr = "a fraction of the edge step" if ($how eq 'fraction');
  $descr = "the atomic value" if ($how eq 'atomic');
  set_properties(1, $remember, 0);
  my $message = "Set E0 to $descr for $which groups.";
  Echo($message);
};



sub set_edge_peak {
  my ($group) = @_;
  return 0 if not $groups{$group}->{is_xmu};
  my $zpref = get_Z($config{bkg}{ledgepeak});
  my $zthis = get_Z($groups{$group}->{bkg_z});
  #Echo("Cannot set e0 to white line peak, the bkg->ledgepeak parameter is not set to an element symbol"),
  #  return 0 if (not $zpref);
  Echo("Cannot set E0 to white line peak, \"$groups{$group}->{label}\" is frozen."),
    return 0 if ($groups{$group}->{frozen});
  #Echo("Cannot set E0 to white line peak, \"$groups{$group}->{label}\" is not an L2 or L3 edge."),
  #  return 0 if ($groups{$group}->{fft_edge} !~ /l[23]/i);
  #Echo("Cannot set E0 to white line peak, \"$groups{$group}->{label}\" is below the cutoff Z ($config{bkg}{ledgepeak}) for this algorithm"),
  #  return 0 if ($zthis < $zpref);

  $top->Busy;

  set_edge($group, 'edge');
  $groups{$group}->dispose("## computing derivative to set e0 to the white line peak\n", $dmode);
  $groups{$group}->dispose("set $group.yd = deriv($group.xmu)/deriv($group.energy)\n", $dmode);
  my @x = map {$_ + $groups{$group}->{bkg_eshift}} Ifeffit::get_array("$group.energy");
  my @y = Ifeffit::get_array("$group.yd");
  $groups{$group}->dispose("## arrays $group.energy and $group.yd were just slurped into Athena\n", $dmode);
  $groups{$group}->dispose("erase $group.yd\n", $dmode);

  my $e0index = 0;
  foreach my $e (@x) {
    last if ($e > $groups{$group}->{bkg_e0});
    ++$e0index;
  };
  my ($enear, $ynear) = ($x[$e0index], $y[$e0index]);
  my ($ratio, $i) = (1, 1);
  my ($above, $below) = (0,0);
  while (1) {			# find points that bracket the zero crossing
    (($above, $below) = (0,0)), last unless (exists($y[$e0index + $i]) and $y[$e0index]);
    $ratio = $y[$e0index + $i] / $y[$e0index]; # this ratio is negative for a points bracketing the zero crossing
    ($above, $below) = ($e0index+$i, $e0index+$i-1);
    last if ($ratio < 0);
    ++$i;
    return 0 if ($i == 4000);	# fail safe
  };
  my $wlpeak = sprintf("%.3f", $x[$below] - ($y[$below]/($y[$above]-$y[$below])) * ($x[$above] - $x[$below]));
  $groups{$group}->make(bkg_e0=>$wlpeak);

  project_state(0);
  set_properties(1, $group, 0);
  Echo("E0 set to the peak of the white line for \"$groups{$group}->{label}\"");
  $top->Unbusy;
  return 1;
};



#sub set_e0 {
#  Echo("No data"), return unless ($current);
#  $groups{$current}->make(bkg_e0=>$_[0], update_bkg=>1);
#  &set_properties(0, $current);
#  &Echo("E0 reset to the atomic value for the $_[2] edge of $_[1].")
#};


sub tie_reference {
  Echo("No data!"), return unless $current;
  my ($n, @g) = (0, ());
  foreach my $k (keys %marked) {
    if ($marked{$k}) {
      ++$n;
      push @g, $k;
    };
  };
  Error("You need exactly two marked groups to tie data and reference channel"), return unless ($n == 2);
  Echo("You cannot tie \"$groups{$g[0]}->{label}\".  It's a frozen group."), return if $groups{$g[0]}->{frozen};
  Echo("You cannot tie \"$groups{$g[1]}->{label}\".  It's a frozen group."), return if $groups{$g[1]}->{frozen};
  $groups{$g[0]} -> make(reference=>$g[1]);
  $groups{$g[1]} -> make(reference=>$g[0]);
  set_properties(1, $current, 0);
  project_state(0);
};


## refresh some display elements without calling set_properties
## again. also perform any chores that need attention as normal course
## of plotting. currently this is used to update the display of the
## edge step after redoing a background removal and to perform a
## memory check
sub refresh_properties {
  if ($groups{$current}->{is_xmu}) {
    $widget{bkg_step} -> configure(-validate=>'none', -state=>'normal');
    $widget{bkg_step} -> delete(qw/0 end/);
    $widget{bkg_step} -> insert(0, $groups{$current}->{bkg_step});
    $widget{bkg_step} -> configure(-validate=>'key', -state=>($groups{$current}->{frozen}) ? 'disabled' : 'normal');
    ## $widget{bkg_step} -> configure(-text=>sprintf "%.2f", $groups{$current}->{bkg_step});
  };
  my $memory_ok = $groups{$current}->memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};


sub change_record {
  Echo("Change record type");
  my $d = $top->DialogBox(-title   => "Artemis: change record type",
			  -buttons => ["mu(E)", "xanes", "norm(E)", "detector", "Cancel"],
			  -popover => 'cursor');
  my $how = $groups{$current}->{frozen} ? 'marked' : "this";
  $d -> add('Radiobutton',
	    -variable	=> \$how,
	    -value	=> "this",
	    -text	=> "Change record type of \"$groups{$current}->{label}\" to:",
	    -font	=> $config{fonts}{large},
	    -foreground	=> $config{colors}{activehighlightcolor},)
    -> pack(-anchor=>'w');
  $d -> add('Radiobutton',
	    -variable	=> \$how,
	    -value	=> "marked",
	    -text	=> "Change record type of marked groups to:",
	    -font	=> $config{fonts}{large},
	    -foreground	=> $config{colors}{activehighlightcolor},)
    -> pack(-anchor=>'w');

  my $this = $d -> Show();
  my $add = "";
  Echo("Not changing record type"), return if ($this eq 'Cancel');
  if ($how eq 'this') {
    Echo("Not changing record type, \"$groups{$current}->{label}\" is frozen."), return if ($groups{$current}->{frozen});
    if ($this eq "mu(E)") {
      $groups{$current} -> make(is_xmu=>1, is_xanes=>0, is_nor=>0, not_data=>0, update_bkg=>1);
    } elsif ($this eq "xanes") {
      $groups{$current} -> make(is_xmu=>1, is_xanes=>1, is_nor=>0, not_data=>0, update_bkg=>1);
    } elsif ($this eq "norm(E)") {
      $groups{$current} -> make(is_xmu=>1, is_xanes=>0, is_nor=>1, not_data=>0, update_bkg=>1);
    } elsif ($this eq "detector") {
      $groups{$current} -> make(is_xmu=>0, is_xanes=>0, is_nor=>0, not_data=>1, update_bkg=>1);
    };
    if ($groups{$current}->{reference}) {
      my $ref = $groups{$current}->{reference};
      if ($this eq "mu(E)") {
	$groups{$ref} -> make(is_xmu=>1, is_xanes=>0, is_nor=>0, not_data=>0, update_bkg=>1);
      } elsif ($this eq "xanes") {
	$groups{$ref} -> make(is_xmu=>1, is_xanes=>1, is_nor=>0, not_data=>0, update_bkg=>1);
      } elsif ($this eq "norm(E)") {
	$groups{$ref} -> make(is_xmu=>1, is_xanes=>0, is_nor=>1, not_data=>0, update_bkg=>1);
      } elsif ($this eq "detector") {
	$groups{$ref} -> make(is_xmu=>0, is_xanes=>0, is_nor=>0, not_data=>1, update_bkg=>1);
      };
      $add = " and reference";
    };
    Echo("Changed \"$groups{$current}->{label}\"$add to $this");
  } elsif ($how eq 'marked') {
    foreach my $g (keys (%marked)) {
      next unless $marked{$g};
      next if ($groups{$g}->{frozen});
      if ($this eq "mu(E)") {
	$groups{$g} -> make(is_xmu=>1, is_xanes=>0, is_nor=>0, not_data=>0, update_bkg=>1);
      } elsif ($this eq "xanes") {
	$groups{$g} -> make(is_xmu=>1, is_xanes=>1, is_nor=>0, not_data=>0, update_bkg=>1);
      } elsif ($this eq "norm(E)") {
	$groups{$g} -> make(is_xmu=>1, is_xanes=>0, is_nor=>1, not_data=>0, update_bkg=>1);
      } elsif ($this eq "detector") {
	$groups{$g} -> make(is_xmu=>0, is_xanes=>0, is_nor=>0, not_data=>1, update_bkg=>1);
      };
      if ($groups{$g}->{reference}) {
	my $ref = $groups{$g}->{reference};
	if ($this eq "mu(E)") {
	  $groups{$ref} -> make(is_xmu=>1, is_xanes=>0, is_nor=>0, not_data=>0, update_bkg=>1);
	} elsif ($this eq "xanes") {
	  $groups{$ref} -> make(is_xmu=>1, is_xanes=>1, is_nor=>0, not_data=>0, update_bkg=>1);
	} elsif ($this eq "norm(E)") {
	  $groups{$ref} -> make(is_xmu=>1, is_xanes=>0, is_nor=>1, not_data=>0, update_bkg=>1);
	} elsif ($this eq "detector") {
	  $groups{$ref} -> make(is_xmu=>0, is_xanes=>0, is_nor=>0, not_data=>1, update_bkg=>1);
	};
      };
    };
    Echo("Changed marked groups to $this");
  };
  set_properties(0, $current, 0);
  project_state(0);
};

sub freeze {
  my $how = $_[0];
  my $message;
 SWITCH: {
    ($how eq 'this') and do {	# toggle this group
      my $verb = $groups{$current}->{frozen} ? 'Unfroze' : 'Froze';
      ($groups{$current}->{frozen}) ? $groups{$current}->unfreeze : $groups{$current}->freeze;
      freeze_chores($current);
      $message = "$verb \"$groups{$current}->{label}\"";
      last SWITCH;
    };
    ($how eq 'all') and do {	# freeze all groups
      map {$groups{$_} -> freeze; freeze_chores($_)} (keys (%marked));
      $message = "Froze all groups";
      last SWITCH;
    };
    ($how eq 'none') and do {	# unfreeze all groups
      map {$groups{$_} -> unfreeze; freeze_chores($_)} (keys (%marked));
      $message = "Unfroze all groups";
      last SWITCH;
    };
    ($how eq 'toggle') and do {	# toggle all groups frozen-ness
      map {($groups{$_}->{frozen}) ? $groups{$_}->unfreeze : $groups{$_}->freeze; freeze_chores($_)} (keys (%marked));
      $message = "Toggled frozenness of all groups";
      last SWITCH;
    };
    ($how eq 'marked') and do {	# freeze marked groups
      map {$groups{$_}->freeze if $marked{$_}; freeze_chores($_) } (keys (%marked));
      $message = "Froze marked groups";
      last SWITCH;
    };
    ($how eq 'unmarked') and do { # unfreeze marked groups
      map {$groups{$_}->unfreeze if $marked{$_}; freeze_chores($_) } (keys (%marked));
      $message = "Unfroze marked groups";
      last SWITCH;
    };
    ($how =~ 'regex') and do {	# freeze/unfreeze groups with labels matching regex
      my $regex = "";
      my $what = ($how eq 'regex') ? 'Freeze' : 'Unfreeze';
      my $label = "$what all groups matching this perl regular expression: ";
      my $dialog = get_string($dmode, $label, \$regex, \@regex_history);
      $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
				# then we can move on...
      Echo("Aborting regex matching."), return if ($regex =~ /^\s*$/);
      my $given = $regex;
      my $re;
      if ($config{general}{match_as} eq 'perl') {
	my $is_ok = eval '$re = qr/$regex/i';
	Error("Oops!  \"$regex\" is not a valid regular expression"), return unless $is_ok;
      } else {
	$regex = glob_to_regex($given);
      };
      if ($how eq 'regex') {
	map { $groups{$_}->freeze if ($groups{$_}->{label} =~ /$regex/); freeze_chores($_)} keys %marked;
      } else {
	map { $groups{$_}->unfreeze if ($groups{$_}->{label} =~ /$regex/); freeze_chores($_)} keys %marked;
      };
      push @regex_history, $given;
      $what = ($how eq 'regex') ? 'Froze' : 'Unfroze';
      $message = "$what all groups matching /$given/";
      last SWITCH;
    };
  };
  set_properties(1, $current, 0);
  project_state(0);
  Echo($message);
};

## this is always called *after* the group is (un)frozen
sub freeze_chores {
  my $which = $_[0];
  my @normal = (-fill => $config{colors}{foreground},
		-font => $config{fonts}{med});
  my @frozen = (-fill => $config{colors}{foreground},
		-font => $config{fonts}{medit});
  my $tag = $groups{$which}->{bindtag};
  ## toggle the font for a group list entry for freezing/unfreezing
  if ($groups{$which}->{frozen}) { # make the text the frozen color
    $list -> itemconfigure($groups{$which}->{text}, @frozen);
    $list -> bind($tag, '<Any-Leave>'=>sub{my $this = shift; $this->itemconfigure('current', @frozen); Leave($this)});
  } else {			   # make the text the normal color
    $list -> itemconfigure($groups{$which}->{text}, @normal);
    $list -> bind($tag, '<Any-Leave>'=>sub{my $this = shift; $this->itemconfigure('current', @normal); Leave($this)});
  };
  ## freeze/unfreeze the referent
  if ($groups{$which}->{reference}) {
    if ($groups{$which}->{frozen}) {
      $groups{$groups{$which}->{reference}} -> freeze;
    } else {
      $groups{$groups{$which}->{reference}} -> unfreeze;
    };
  };
};

sub about_group {
  about_marked_groups({$current=>1});
};
sub about_marked_groups {
  my $r_marked = $_[0];
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my $message = q{};
  my @list = sort {($list->bbox($groups{$a}->{text}))[1] <=>
		     ($list->bbox($groups{$b}->{text}))[1]} (keys (%$r_marked));
  foreach my $k (@list) {
    next unless ($$r_marked{$k});
    $message .= "\n\n"   . &identify_group($k);
    $message .= "\n\n" . &group_stats($k);
    $message .= "\n\n" . sprintf("epsilon_k=%.5f, epsilon_R=%.5f, recommended kmax=%.3f", $groups{$k}->chi_noise());
    $message .= "\n\n" . &show_mu_str unless $groups{$k}->{is_merge};
    $message .= "\n\n" . &nknots($k) if ($groups{$k}->{is_xmu} and not $groups{$k}->{is_xanes});
    $message .= "\n\n" . &groupIndex($k);
    $message .= "\n\n" . "This group is tied to \"" . $groups{$groups{$k}->{reference}}->{label} . "\"" if $groups{$k}->{reference};
    $message .= "\n\nThis groups is frozen.\n" if $groups{$k}->{frozen};
    $message .= "\n\n" . "-" x 60;
  };
  $message =~ s/^\n//;
  $message =~ s/-+$//;
  $message .= "\n\n";
  my $dialog =
    $top -> DialogBox(-title          => 'Athena: About groups',
		      -buttons        => [qw/OK/],
		      -default_button => 'OK');
  my $txt = $dialog -> Scrolled("ROText",
				-width=>60,
				-height=>12,
				-wrap=>'word',
				-scrollbars=>'oe',
			       ) -> pack(-fill=>'y', -expand=>1);
  $txt -> Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
  $txt -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
  $txt -> insert('end', $message, 'text');
  disable_mouse3($txt);
  my $response = $dialog->Show();
};



sub identify_group {
  Echo("No data"), return unless ($current);
  my $this = $_[0] || $current;
  my $message;
  my $group = $groups{$this}->{group};
  my $label = "\"" . $groups{$this}->{label} . "\"";
  SWITCH: {
      my $what = "";
      ($groups{$this}->{is_merge}) and ($what  = " merged");
      ($groups{$this}->{is_diff})  and ($what .= " difference");
      ($groups{$this}->{is_pixel}) and ($what .= " pixel");

      ($groups{$this}->{not_data}) and do {
	$message = "$label is a detector or peak fit record.  It can be plotted only in energy.";
	last SWITCH;
      };
      ($groups{$this}->{is_xanes}) and do {
	$message = "$label is a$what xanes record.  It can be plotted only in energy.";
	last SWITCH;
      };
      ($groups{$this}->{is_nor}) and do {
	$message = "$label is a$what normalized mu(E) record.  It can be plotted in any space.";
	last SWITCH;
      };
      ($groups{$this}->{is_bkg}) and do {
	$message = "$label is a$what background record.  It can be plotted in any space.";
	last SWITCH;
      };
      ($groups{$this}->{is_xmu}) and do {
	$message = "$label is a$what mu(E) record.  It can be plotted in any space.";
	last SWITCH;
      };
      ($groups{$this}->{is_chi}) and do {
	$message = "$label is a$what chi(k) record.  It can be plotted in k-, R-, or q-space.";
	last SWITCH;
      };
      ($groups{$this}->{is_rsp}) and do {
	$message = "$label is a$what chi(R) record.  It can be plotted in R- or q-space.";
	last SWITCH;
      };
      ($groups{$this}->{is_qsp}) and do {
	$message = "$label is a$what chi(q) record.  It can be plotted only in q-space.";
	last SWITCH;
      };
    };
  ##Echo($message . "  It's group name is \"" . $group . "\"");
  return $message . "  It's group name is \"" . $group . "\"";
};

sub group_stats {
  Echo("No data"), return unless ($current);
  my $this = $_[0] || $current;
  my $message;
  my $group = $groups{$this}->{group};
  SWITCH: {
      ($groups{$this}->{not_data}) and do {
	my @x = Ifeffit::get_array($group.".energy");
	$message = sprintf "This detector or peak fit record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_xanes}) and do {
	my @x = Ifeffit::get_array($group.".energy");
	$message = sprintf "This xanes record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_nor}) and do {
	my @x = Ifeffit::get_array($group.".energy");
	$message = sprintf "This normalized mu(E) record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_bkg}) and do {
	my @x = Ifeffit::get_array($group.".energy");
	$message = sprintf "This background record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_xmu}) and do {
	my @x = Ifeffit::get_array($group.".energy");
	$message = sprintf "This mu(E) record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_chi}) and do {
	my @x = Ifeffit::get_array($group.".k");
	$message = sprintf "This chi(k) record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_rsp}) and do {
	my @x = Ifeffit::get_array($group.".r");
	$message = sprintf "This chi(R) record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
      ($groups{$this}->{is_qsp}) and do {
	my @x = Ifeffit::get_array($group.".q");
	$message = sprintf "This chi(q) record has %d points from %.3f to %.3f",
	  $#x+1, $x[0], $x[$#x];
	last SWITCH;
      };
    };
  ##Echo($message);
  return $message;
};

sub show_mu_str {
  my $mu_str = $groups{$current}->{mu_str};
  $mu_str =~ s/$current\.//g;
  $mu_str =~ s/\(/( /g;
  $mu_str =~ s/\)/ )/g;
  ##Echo($groups{$current}->{label} . ": mu(E) was constructed from columns as: $mu_str");
  return "mu(E) was constructed from columns as: $mu_str";
};


sub nknots {
  my $this = $_[0] || $current;
  my $kmin   = $groups{$this}->{bkg_spl1};
  my $kmax   = $groups{$this}->{bkg_spl2};
  my $deltak = $kmax - $kmin;
  my $nidp   = int( 2 * $deltak * $groups{$this}->{bkg_rbkg} / PI ) + 1;
  my $label  = $groups{$this}->{label};
  return "\"$label\" uses $nidp spline knots (evenly spaced in k between $kmin and $kmax, inclusive)";
  ##Echo("\"$label\" uses $nidp spline knots (evenly spaced in k between $kmin and $kmax, inclusive)");
};

sub groupIndex {
  my $i = 1;
  foreach my $g (&sorted_group_list) {
    return "\"$groups{$g}->{label}\" is item number $i in the groups list." if ($g eq $_[0]);
    ++$i;
  };
}


sub sorted_group_list {
  my @list = sort {($list->bbox($groups{$a}->{text}))[1] <=>
		     ($list->bbox($groups{$b}->{text}))[1]} (keys (%marked));
  return @list;
};

## END OF GROUP OPERATIONS SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  data alignment.

## pop-up a palette for interactively aligning one scan ralative to
## another by comparing norm(E) or deriv(E)
sub align_two {
  Echo("No data!"), return unless $current;
  my %align_params;
  $align_params{space} = $_[0];
  $align_params{space} = ($align_params{space} eq 'x') ? 'em' : 'em'.$align_params{space};
  ($align_params{space} = 'emdsss') if ($align_params{space} eq 'ems');
  my $color = $plot_features{c1};

  ##Echo("You cannot align to the Default Parameters"), return
  Echo("No data!"), return if ($current eq "Default Parameters");

  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };
  Echo("You need two or more xmu groups to align"), return unless ($#keys >= 1);

  $align_params{fit} = $config{align}{fit} || 'd';
  $align_params{keys} = \@keys;
  $align_params{standard} = $keys[0];
  my $standard_lab = "1: " . $groups{$keys[0]}->{label};
  if ($align_params{standard} eq $current) {	# make sure $current is sensible given
    set_properties(1, $keys[1], 0);# that $keys[0] is the standard
    # adjust the view
    my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
    ($here < 0) and ($here = 0);
    my $full = ($list->bbox(@skinny_list))[3] + 5;
    $list -> yview('moveto', $here/$full);
  };

  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{align}{emin};
  $plot_features{emax} = $config{align}{emax};
  project_state($ps);		# don't toggle if currently saved


  $align_params{shift} = $groups{$current}->{bkg_eshift};
  $align_params{prior_shift} = $groups{$current}->{bkg_eshift};

  $fat_showing = 'align';
  $hash_pointer = \%align_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $align = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$align -> packPropagate(0);
  $which_showing = $align;

  $align -> Label(-text=>"Data alignment",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## select the alignment standard
  my $frame = $align -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -pady=>8);
  $frame -> Label(-text=>"Standard: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>0, -column=>0, -sticky=>'e', -ipady=>2);

  $widget{align_menu} = $frame -> BrowseEntry(-variable => \$standard_lab,
					      @browseentry_list,
					      -browsecmd => sub {
						my $text = $_[1];
						my $this = $1 if ($text =~ /^(\d+):/);
						Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless $this;
						$this -= 1;
						$align_params{standard}=$align_params{keys}->[$this];
						#$standard_lab="$groups{$s}->{label} ($s)";
						&do_eshift(\%align_params, $current);
					      })
    -> grid(-row=>0, -column=>1, -sticky=>'w');
  my $i = 1;
  foreach my $s (@keys) {
    $widget{align_menu} -> insert("end", "$i: $groups{$s}->{label}");
    ++$i;
  };

  ## the group for alignment is the current group in the group list
  $frame -> Label(-text=>"Other: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{align_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					   -foreground=>$config{colors}{button},
					  )
    -> grid(-row=>1, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);
  my $other_label;

  ## select the way to plot the data
  $frame -> Label(-text=>"Plot as: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>2, -column=>0, -sticky=>'e', -ipady=>2);
  my $space_label = 'xmu';
  ($space_label = 'normalized xmu')      if ($align_params{space} eq 'emn');
  ($space_label = 'derivative')          if ($align_params{space} eq 'emd');
  ($space_label = 'smoothed derivative') if ($align_params{space} eq 'emdsss');
  my $menu = $frame -> Optionmenu(-textvariable => \$space_label,
				  -borderwidth=>1,
				  -width=>19, -justify=>'right')
    -> grid(-row=>2, -column=>1, -sticky=>'w');
  foreach my $p (qw(em emn emd emdsss)) {
    my $label = 'xmu';
    ($label = 'normalized xmu')      if ($p eq 'emn');
    ($label = 'derivative')          if ($p eq 'emd');
    ($label = 'smoothed derivative') if ($p eq 'emdsss');
    $menu -> command(-label => $label,
		     -command=>sub{$align_params{space}=$p;
				   $space_label=$label;
				   &do_eshift(\%align_params, $current);
				 });
  };

  ## select the fitting function
  $frame -> Label(-text=>"Fit as: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>3, -column=>0, -sticky=>'e', -ipady=>2);
  my $fit_label = 'derivative';
  ($fit_label = 'smoothed derivative') if ($align_params{fit} eq 's');
  $menu = $frame -> Optionmenu(-textvariable => \$fit_label,
			       -borderwidth=>1,
			       -width=>19, -justify=>'right')
    -> grid(-row=>3, -column=>1, -sticky=>'w');
  foreach my $p (qw(d s)) {
    my $label = 'derivative';
    ($label = 'smoothed derivative') if ($p eq 's');
    $menu -> command(-label => $label,
				   -command=>sub{$align_params{fit}=$p;
						 $fit_label=$label;
					       });
  };


  $align -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');
  $align -> Button(-text=>'Return to the main window',  @button_list,
		   -background=>$config{colors}{background2},
		   -activebackground=>$config{colors}{activebackground2},
		   -command=>sub{$groups{$current} -> make(bkg_eshift=>$align_params{shift},
							   update_bkg=>1);
				 ## tie together data and reference
				 if ($groups{$current}->{reference} and exists($groups{$groups{$current}->{reference}})) {
				   $groups{$groups{$current}->{reference}} -> make(bkg_eshift=>$align_params{shift},
										   update_bkg=>1);
				 };
				 &reset_window($align, "alignment", \@save);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $align -> Button(-text=>'Document section: aligning data', @button_list,
		   -command=>sub{pod_display("process::align.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);



  ## frame with buttons in
  $frame = $align -> Frame(-borderwidth=>2, -relief=>'groove')
    -> pack(-side=>'bottom', -fill=>'x');

  my $bbox =  $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'bottom');

  my $lab =  $bbox -> Frame(-borderwidth=>2, -relief=>'flat')
    ->grid(-columnspan=>2, -row=>0, -column=>0, -padx=>2, -pady=>4, -sticky=>'ew');

  $widget{align_other_label} = $lab ->
    Label(
	  ##-text=>"Shift \"$groups{$current}->{label}\" by ",
	  -text=>"Shift by ",
	  -foreground=>$config{colors}{activehighlightcolor},
	 )
    -> pack(-side=>'left');
  $widget{align_result} = $lab -> RetEntry(-textvariable=>\$align_params{shift},
					   -validate=>'key',
					   -command=>sub{
					     $groups{$current} -> make(bkg_eshift=>$align_params{shift}, update_bkg=>1); # update object then plot
					     ## tie together data and reference
					     if ($groups{$current}->{reference} and exists($groups{$groups{$current}->{reference}})) {
					       $groups{$groups{$current}->{reference}} -> make(bkg_eshift=>$align_params{shift});
					     };
					   },
					   -validatecommand=>[\&set_variable, 'al_en'],
					   -width=>6)
    -> pack(-side=>'left');
  $lab -> Label(-text=>" eV.",
		-foreground=>$config{colors}{activehighlightcolor},)
    -> pack(-side=>'left');



  $widget{align_auto} = $bbox -> Button(-text=>"Auto align", @button_list,
					-command=>sub{Echo("Not aligning: \"$groups{$current}->{label}\" is a frozen group."), return if $groups{$current}->{frozen};
						      $align_params{shift} = auto_align($align_params{standard}, $current, $align_params{fit});
						      do_eshift(\%align_params, $current)})
    ->grid(-columnspan=>2, -row=>1, -column=>0, -padx=>2, -pady=>4, -sticky=>'ew');
  $widget{align_replot} = $bbox -> Button(-text=>"Replot", @button_list,
					  -command=>sub{do_eshift(\%align_params, $current)})
    ->grid(-columnspan=>2, -row=>2, -column=>0, -padx=>2, -pady=>4, -sticky=>'ew');

  my $row = 3;
  foreach my $e (5, 1, 0.5, 0.1) {
    $widget{"align_plus".$e} =
      $bbox -> Button(-text=>"-".$e, -width=>6, @button_list,
		      -command=>sub{Echo("Not aligning: \"$groups{$current}->{label}\" is a frozen group."), return if $groups{$current}->{frozen};
				    $align_params{shift} -= $e;
				    ($align_params{shift} = 0) if (abs($align_params{shift}) < EPSI);
				    do_eshift(\%align_params, $current)})
	->grid(-row=>$row, -column=>0, -padx=>2, -pady=>4);
    $widget{"align_minus".$e} =
      $bbox -> Button(-text=>"+".$e, -width=>6, @button_list,
		      -command=>sub{Echo("Not aligning: \"$groups{$current}->{label}\" is a frozen group."), return if $groups{$current}->{frozen};
				    $align_params{shift} += $e;
				    ($align_params{shift} = 0) if (abs($align_params{shift}) < EPSI);
				    do_eshift(\%align_params, $current)})
	->grid(-row=>$row, -column=>1, -padx=>2, -pady=>4);
    ++$row;
  };
  $widget{align_restore} =
    $bbox -> Button(-text=>"Restore value", @button_list,
		    -command=>sub{Echo("Not aligning: \"$groups{$current}->{label}\" is a frozen group."), return if $groups{$current}->{frozen};
				  $align_params{shift} = $align_params{prior_shift};
				  do_eshift(\%align_params, $current)})
      ->grid(-columnspan=>2, -row=>++$row, -column=>0, -padx=>2, -pady=>4, -sticky=>'ew');

  $widget{align_marked} =
    $bbox -> Button(-text=>"Align all\nmarked groups", @button_list,
		    -command=>sub{
		      Echonow("Aligning marked groups ...");
		      $top -> Busy;
		      foreach my $g (&sorted_group_list) {
			next unless $marked{$g};
			next if ($align_params{standard} eq $g);
			Echonow("Auto-aligning \"$groups{$g}->{label}\"");
			my $sh = auto_align($align_params{standard}, $g, $align_params{fit});
			$groups{$g} -> make(bkg_eshift=>$sh, update_bkg=>1); # update object then plot
			## tie together data and reference
			if ($groups{$g}->{reference} and exists($groups{$g}->{reference})) {
			  $groups{$groups{$g}->{reference}} -> make(bkg_eshift=>$sh);
			};
		      };
		      $align_params{shift} = $groups{$current}->{bkg_eshift};
		      do_eshift(\%align_params, $current);
		      $top -> Unbusy;
		      Echonow("Aligning marked groups ... done!");
		    })
      ->grid(-columnspan=>2, -rowspan=>2, -row=>1, -column=>2,
	     -padx=>12, -pady=>4, -sticky=>'new');

  do_eshift(\%align_params, $current);
  $plotsel -> raise('e');
  $top -> update;
};




## perform the e0 shift requested by the align_two subroutine and replot
sub do_eshift {
  my ($r, $gr) = @_;
  my ($sp, $st, $sh) = ($$r{space}, $$r{standard}, $$r{shift});

  Echo("Not aligning: \"$groups{$gr}->{label}\" is a frozen group.") if $groups{$gr}->{frozen};
  Error("Alignment aborted: " . $groups{$gr}->{label} . " is not an xmu group."),
    return unless ($groups{$gr}->{is_xmu});

  my $color = $plot_features{c1};
  my $scale = $groups{$gr}->{plot_scale};
  my $key   = $groups{$gr}->{label};
  my $other_string = q{};
 SWITCH: {
    ($sp eq 'emn')  and do {
      if ($groups{$gr}->{bkg_flatten}) {
	$other_string = "plot($gr.energy+$sh, $gr.flat, style=lines, color=$color, key=\"$key\")";
      } else {
	$other_string = "plot($gr.energy+$sh, $gr.norm, style=lines, color=$color, key=\"$key\")";
      };
      last SWITCH;
    };
    ($sp eq 'emd')  and do {
      $other_string = "plot($gr.energy+$sh, $scale*deriv($gr.xmu)/deriv($gr.energy), style=lines, color=$color, key=\"$key\")";
      last SWITCH;
    };
    ($sp eq 'emdsss')  and do {
      $other_string  = "set $gr.der = deriv(smooth(smooth(smooth($gr.xmu))))/deriv($gr.energy)\n";
      $other_string .= "plot($gr.energy+$sh, $scale*$gr.der, style=lines, color=$color, key=\"$key\")";
      last SWITCH;
    };
    ($sp eq 'em')  and do {
      $other_string = "plot($gr.energy+$sh, $gr.xmu, style=lines, color=$color, key=\"$key\")";
      last SWITCH;
    };
  };
  $groups{$gr} -> dispose("## aligning $gr to $st", $dmode);
  $groups{$gr} -> make(bkg_eshift=>$sh, update_bkg=>1); # update object then plot
  ## tie together data and reference
  if ($groups{$gr}->{reference} and exists($groups{$groups{$gr}->{reference}})) {
    $groups{$groups{$gr}->{reference}} -> make(bkg_eshift=>$sh);
  };
  if ($current eq $gr) {
    my $v = $groups{$gr}->{bkg_eshift};
    $widget{bkg_eshift} -> configure(-validate=>'none');
    $widget{bkg_eshift} -> delete(qw/0 end/);
    $widget{bkg_eshift} -> insert(0, $sh);
    $widget{bkg_eshift} -> configure(-validate=>'key');
    ##$widget{bkg_eshift} -> configure(-text=>$sh);
  };
  $groups{$st} -> plotE($sp,$dmode,\%plot_features, \@indicator);
  $groups{$gr} -> dispatch_bkg($dmode) if ($$r{space} eq 'emn');
  $groups{$gr} -> dispose($other_string, $dmode);
  $last_plot='e';
  ## keep detector groups aligned with their parent xmu group
  foreach my $g (@{$groups{$gr}->{detectors}}) {
    $groups{$g}->make(bkg_eshift=>$sh);
  };
  project_state(0);
  $top -> update;
};


## align two groups by computing a difference of derivative spectrum
## and minimizing an applied e0 shift
sub auto_align {
  my ($standard, $other, $how) = @_;
  return 0 if (($standard eq 'None') or ($other eq 'None'));

  $standard = $groups{$standard}->{group};
  my $st_e0 = $groups{$standard}->{bkg_eshift};
  my ($xmin, $xmax) = (int($groups{$standard}->{bkg_e0}-50),
		       int($groups{$standard}->{bkg_e0}+100));
  $other    = $groups{$other}->{group};
  my $ot_e0 = $groups{$other}->{bkg_eshift};
  my $command = "## auto aligning $other to $standard\n";
  $command   .= "guess(aa___esh=$ot_e0, aa___scale=1)\n";
  $command   .= "def($other.xmui = interp($other.energy+aa___esh, $other.xmu, $standard.energy+$st_e0),\n";
  if ($how eq 'd') {
    $command   .= "    aa___.res = deriv($standard.xmu)/deriv($standard.energy) - aa___scale*deriv($other.xmui)/deriv($other.energy))\n";
  } else {
    $command   .= "    aa___.res = smooth(smooth(smooth(deriv($standard.xmu)/deriv($standard.energy)))) - aa___scale*smooth(deriv($other.xmui)/deriv($other.energy)))\n";
  };
  $command   .= "minimize(aa___.res, x=$standard.energy, xmin=$xmin, xmax=$xmax)\n";
  $groups{$standard} -> dispose($command, $dmode); # do it
  my $esh = Ifeffit::get_scalar("aa___esh");
  ($esh=0) unless ($esh =~ /-?(\d+\.?\d*|\.\d+)/);
  $command    = "set(aa___.res = aa___.res, $other.xmui = $other.xmui)\n";
  $command   .= "unguess\n";
  $command   .= "erase aa___esh aa___scale aa___.res $other.xmui\n";
  $command   .= "## done auto aligning\n";
  $groups{$standard} -> dispose($command, $dmode); # clean up
  project_state(0);
  return sprintf("%.3f",$esh);	# return the e0 shift
};



## END OF DATA ALIGNMENT SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  converting pixel data to energy

sub pixel {
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my %pixel_params = (offset    => 0,
		      linear    => $config{pixel}{resolution},
		      quad      => 0,
		      constrain => 1,);

  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{pixel}{emin};
  $plot_features{emax} = $config{pixel}{emax};


  my @keys = ();
  my $count_pixel = 0;
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
    ($pixel_params{standard} = $k) if (($k eq $current) and not $groups{$current}->{is_pixel});
    ++$count_pixel if ($groups{$k}->{is_pixel});
  };
  Echo("You need two or more xmu groups to do pixel to energy conversion"),
    return unless ($#keys >= 1);
  Echo("You need at least one pixel group to do pixel to energy conversion"),
    return unless ($count_pixel >= 1);

  $pixel_params{keys} = \@keys;
  $pixel_params{standard} ||= $keys[0];
  my $standard_lab = "1: ".$groups{$keys[0]}->{label};
  unless ($groups{$current}->{is_pixel}) {
    foreach my $k (&sorted_group_list) {
      if ($groups{$k}->{is_pixel}) {
	set_properties(1, $k, 0);
	last;
      };
    };
    # adjust the view
    my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
    ($here < 0) and ($here = 0);
    my $full = ($list->bbox(@skinny_list))[3] + 5;
    $list -> yview('moveto', $here/$full);
  };

  $fat_showing = 'pixel';
  $hash_pointer = \%pixel_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $pixel = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$pixel -> packPropagate(0);
  $which_showing = $pixel;

  $pixel -> Label(-text=>"Dispersive XAS: convert pixels to energy",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');


  ## select the alignment standard
  my $frame = $pixel -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -ipady=>6);
  $widget{pixel_standard} = $frame -> Button(-text=>"Standard: ", @label_button,
					    -foreground=>$config{colors}{activehighlightcolor},
					    -activeforeground=>$config{colors}{activehighlightcolor},
					    -command=>[\&Echo, "The spectrum to which the pixel data will be aligned in energy."]
		  )
    -> grid(-row=>0, -column=>0, -sticky=>'e', -ipady=>2);

  my $menu = $frame -> BrowseEntry(-variable => \$standard_lab,
				   @browseentry_list,
				   -browsecmd => sub {
				     my $text = $_[1];
				     my $this = $1 if ($text =~ /^(\d+):/);
				     Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless $this;
				     $this -= 1;
				     $pixel_params{standard}=$pixel_params{keys}->[$this];
				     #$standard_lab="$groups{$s}->{label} ($s)";
				     &pixel_setup(\%pixel_params);
				   })
    -> grid(-row=>0, -column=>1, -columnspan=>2, -sticky=>'w');
  ##print join("\n",(($menu->children)[0]->children)[1]->children), $/;
  ##Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
  my $i = 1;
  foreach my $s (@keys) {
    $menu -> insert("end", "$i: $groups{$s}->{label}");
    ++$i;
  };



#   my $menu = $frame -> Optionmenu(-textvariable => \$standard_lab,
# 				  -borderwidth=>1, )
#     -> grid(-row=>0, -column=>1, -sticky=>'w');
#   foreach my $s (@keys) {
#     next if $groups{$s}->{is_pixel};
#     $menu -> command(-label => $groups{$s}->{label},
# 		     -command=>sub{$pixel_params{standard}=$s;
# 				   $standard_lab=$groups{$s}->{label};
# 				   &pixel_setup(\%pixel_params);
# 				 });
#   };

  ## the group for alignment is the current group in the group list
  $frame -> Button(-text=>"Other: ",
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   @label_button,
		   -command=>[\&Echo, "The group currently selected for alignment to the standard."]
		  )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{pixel_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					   -foreground=>$config{colors}{button},
					   -width=>20)
    -> grid(-row=>1, -column=>1, -columnspan=>2, -sticky=>'w', -pady=>2, -padx=>2);
  my $other_label;

  $widget{pixel_refine} = $frame ->
    Button(-text=>'Refine alignment parameters', @button_list,
	   -command=>sub{
	     #pixel_refine(\%pixel_params, 1);
	     pixel_refine(\%pixel_params, 2);
	     #$widget{pixel_make} -> configure(-state=>'normal');
	   })
    -> grid(-row=>2, -column=>0, -columnspan=>3, -sticky=>'ew', -padx=>4);


  $frame -> Button(-text=>"Offset: ",
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   @label_button,
		   -command=>[\&Echo, "The constant term in the calibration refinement."])
    -> grid(-row=>3, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{pixel_offset} = $frame -> Entry(-width=>8,
					  -textvariable=>\$pixel_params{offset})
    -> grid(-row=>3, -column=>1, -sticky=>'w', -ipady=>2);
  $widget{pixel_constrain} = $frame ->
    Checkbutton(-text=>'constrain offset to linear term',
		-onvalue=>1, -offvalue=>0,
		-selectcolor=> $config{colors}{single},
		-variable=>\$pixel_params{constrain})
      -> grid(-row=>3, -column=>2, -sticky=>'w', -ipady=>2);

  $frame -> Button(-text=>"Linear: ",
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   @label_button,
		   -command=>[\&Echo, "The linear term in energy in the calibration refinement."])
    -> grid(-row=>4, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{pixel_linear} = $frame -> Entry(-width=>8,
					-textvariable=>\$pixel_params{linear})
    -> grid(-row=>4, -column=>1, -sticky=>'w', -ipady=>2);
  $widget{pixel_linear_button} = $frame -> Button(-text=>'Reset offset',
						  @button_list,
						  -command=>
						  sub {
						    my $stan  = $groups{$pixel_params{standard}}->{group};
						    $pixel_params{offset} = $groups{$stan}->{bkg_e0} - $groups{$current}->{bkg_e0}*$pixel_params{linear};
						  } )
    -> grid(-row=>4, -column=>2, -sticky=>'w', -ipady=>2, -padx=>4);


  $frame -> Button(-text=>"Quadratic: ",
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   @label_button,
		   -command=>[\&Echo, "The quadratic term in energy in the calibration refinement."])
    -> grid(-row=>5, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{pixel_quad} = $frame -> Entry(-width=>8,
					-textvariable=>\$pixel_params{quad})
    -> grid(-row=>5, -column=>1, -sticky=>'w', -ipady=>2);


  $widget{pixel_replot} = $frame ->
    Button(-text=>'Replot standard and pixel data', @button_list,
	   -command=>sub{pixel_setup(\%pixel_params)},
	  )
    -> grid(-row=>6, -column=>0, -columnspan=>3, -sticky=>'ew', -padx=>4);
  $widget{pixel_make} = $frame ->
    Button(-text=>'Make data group', @button_list,
	   -command=>sub{&pixel_make_group(\%pixel_params)},)
    -> grid(-row=>7, -column=>0, -columnspan=>3, -sticky=>'ew', -padx=>4,);

  $widget{pixel_all} = $frame ->
    Button(-text=>'Convert all MARKED pixel groups', @button_list,
	   -command=>sub{&pixel_make_all(\%pixel_params)},)
    -> grid(-row=>8, -column=>0, -columnspan=>3, -sticky=>'ew', -pady=>3, -padx=>4);




  $pixel -> Button(-text=>'Return to the main window',  @button_list,
		   -background=>$config{colors}{background2},
		   -activebackground=>$config{colors}{activebackground2},
		   -command=>sub{foreach my $g (keys %groups) {	# clean up def-ed arrays
				   next unless $groups{$g}->{made_pixel};
				   $groups{$g}->make(made_pixel=>0);
				   $groups{$g}->dispose("erase $g.ec $g.xc", $dmode);
				   ##$groups{$g}->dispose("erase $g.xc", $dmode);
				 };
				 $groups{$current}->dispose("unguess", $dmode);
				 &reset_window($pixel, "dispersive XAS calibration", \@save);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $pixel -> Button(-text=>'Document section: converting pixel data to energy', @button_list,
		   -command=>sub{pod_display("process::pixel.pod")},)
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  &pixel_setup(\%pixel_params);
  $plotsel -> raise('e');
  $top -> update;
};


sub pixel_initial {
  my $rhash = $_[0];
  my $stan  = $groups{$$rhash{standard}}->{group};
  $$rhash{linear} ||= 0.4;
  $$rhash{quad}   ||= 0;
  $$rhash{offset} ||= $groups{$stan}->{bkg_e0} - $groups{$current}->{bkg_e0}*$$rhash{linear};
};

sub pixel_setup {
  my $rhash = $_[0];
  my $stan  = $groups{$$rhash{standard}}->{group};
  my $group = $groups{$current}->{group};
  $groups{$stan} ->dispatch_bkg if $groups{$stan} ->{update_bkg};
  $groups{$group}->dispatch_bkg if $groups{$group}->{update_bkg};
  &pixel_initial($rhash);
  my $command = "set(pixel___b=$$rhash{linear}, pixel___c=$$rhash{quad},\n";
  $command   .= "    pixel___a = $$rhash{offset})\n";
  $command   .= "def($group.ec = pixel___a + pixel___b*$group.energy + abs(pixel___c)*$group.energy**2,\n";
  $command   .= "    $group.xc = qinterp($group.ec, $group.flat, $stan.energy))\n";
  $groups{$current} -> dispose($command, $dmode);
  $groups{$current} -> make(made_pixel=>1);
  &pixel_plot($rhash);
};

sub pixel_refine {
  my $rhash = $_[0];
  my $order = $_[1];
  Echonow("Refining pixel calibration parameters ...");
  my $stan  = $groups{$$rhash{standard}}->{group};
  my $group = $groups{$current}->{group};
  $groups{$stan} ->dispatch_bkg if $groups{$stan} ->{update_bkg};
  $groups{$group}->dispatch_bkg if $groups{$group}->{update_bkg};
  my $e0 = $groups{$$rhash{standard}}->{bkg_e0};
  my $ee = $groups{$$rhash{standard}}->{bkg_e0} + 20;
  my $ed = $groups{$current}->{bkg_e0};
  my $command = "guess(pixel___b=$$rhash{linear}, pixel___c=$$rhash{quad})\n" if ($order == 2);
  if ($$rhash{constrain}) {
    $command   .= "def(pixel___a=$e0-pixel___b*$ed)\n";
  } else {
    $command   .= "guess(pixel___a=$$rhash{offset},)\n";
  };
  $command   .= "step $stan.energy $ee 0 p___ixel.step\n";
  $command   .= "set p___ixel.drop   = -1*(p___ixel.step - 1)\n";
  $command   .= "def(p___ixel.first  = $stan.flat*p___ixel.drop - $group.xc*p___ixel.drop,\n";
  $command   .= "    p___ixel.second = p___ixel.step * sqrt(abs($stan.energy-$e0)) * (($stan.flat-1) - ($group.xc-1)),\n";
  $command   .= "    p___ixel.diff   = p___ixel.first + p___ixel.second)\n";
  $command   .= "set(pixel___xmin = floor($group.ec),\n";
  $command   .= "    pixel___xmax = ceil($group.ec))\n";
  $command   .= "minimize(p___ixel.diff, x=$stan.energy, xmin=pixel___xmin, xmax=pixel___xmax)\n";
  ##$command   .= "minimize($group.diff)\n";
  $groups{$current} -> dispose($command, $dmode);
  $$rhash{offset} = sprintf("%.5f", Ifeffit::get_scalar("pixel___a"));
  $$rhash{linear} = sprintf("%.5f", Ifeffit::get_scalar("pixel___b"));
  $$rhash{quad}   = sprintf("%.5g", Ifeffit::get_scalar("pixel___c"));
  Echonow("Refining pixel calibration parameters ... replotting ...");
  &pixel_plot($rhash);
  Echo("Refining pixel calibration parameters ... replotting ... done!");
};

sub pixel_plot {
  my $rhash = $_[0];
  my $stan  = $groups{$$rhash{standard}}->{group};
  my $group = $groups{$current}->{group};
  $groups{$$rhash{standard}}->plotE('emn', $dmode, {emin=>$plot_features{emin},
						    emax=>$plot_features{emax},
						   }, \@indicator);
  my $fitcolor  = $config{plot}{c1};
  my $command = "plot($group.ec, $group.flat, style=lines, color=$fitcolor, key=$groups{$current}->{label})\n";
  $groups{$current} -> dispose($command, $dmode);
};

sub pixel_make_group {
  my $rhash = $_[0];
  my $stan  = $groups{$$rhash{standard}}->{group};
  my $was   = $groups{$current}->{group};
  (my $group = $groups{$current}->{label}) =~ s/_pixel/_data/;
  my ($new, $label) = group_name($group);
  $groups{$new} = Ifeffit::Group -> new(group=>$new, label=>$label);
  $groups{$new} -> set_to_another($groups{$$rhash{standard}});
  $groups{$new} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0,
			is_qsp => 0, is_bkg => 0, is_pixel => 0,
			not_data => 0);
  $groups{$new} -> make(bkg_e0 => $groups{$$rhash{standard}}->{bkg_e0},
			file => $groups{$current}->{label} . " converted to energy",
		       );

  $groups{$new}->{titles} = [];
  push @{$groups{$new}->{titles}},
    ("Converted from pixel data $groups{$current}->{label}",
     "Calibrated to $groups{$$rhash{standard}}->{label}",
     "Offset: $$rhash{offset}",
     "Linear term: $$rhash{linear}",
     "Quadratic term: $$rhash{quad}");
  $groups{$new} -> put_titles;
  my $sets = "set($new.energy = $was.ec + " . $groups{$$rhash{standard}}->{bkg_eshift} . ",\n";
  $sets   .= "    $new.xmu = $was.xmu)";
  $groups{$new} -> dispose($sets, $dmode);

  my ($pre1, $pre2, $nor1, $nor2, $spl1, $spl2, $kmin, $kmax) =
    set_range_params($new);
  $groups{$new} -> make(
			bkg_pre1  => $pre1,
			bkg_pre2  => $pre2,
			bkg_nor1  => $nor1,
			bkg_nor2  => $nor2,
			bkg_spl1  => $spl1,
			bkg_spl2  => $spl2,
			bkg_spl1e => $groups{$new}->k2e($spl1),
			bkg_spl2e => $groups{$new}->k2e($spl2),
			fft_kmin  => $kmin,
			fft_kmax  => $kmax,
		       );
  $groups{$new} -> kmax_suggest(\%plot_features) if ($groups{$new}->{fft_kmax} == 999);

  $groups{$new} -> make(update_bkg => 1);
  ++$line_count;
  fill_skinny($list, $new, 1);
  my $memory_ok = $groups{$new}
    -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);

};

sub pixel_make_all {
  my $rhash = $_[0];
  my $m = 0;
  map {$m += $_} values %marked;
  Error("Batch conversion aborted.  There are no marked groups."),   return 1 unless ($m);
  ##Error("Merging aborted.  There is just 1 marked group."), return 1 if ($m==1);
  Echonow("Batch converting marked groups from pixel to energy ...");
  foreach my $g (&sorted_group_list) {
    next unless $marked{$g};
    next unless $groups{$g}->{is_pixel};
    set_properties(0, $g, 0);
    &pixel_make_group($rhash);
  };
  Echo("Batch converting marked groups from pixel to energy ... done!");
};
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  data calibration.


sub calibrate {
  Echo("No data!"), return unless $current;
  my $space = $_[0];

  ##Echo("You cannot align to the Default Parameters"), return
  Echo("No data!"), return if ($current eq "Default Parameters");

  my @keys = ();
  #sort {($list->bbox($groups{$a}->{text}))[1] <=>
  #		     ($list->bbox($groups{$b}->{text}))[1]} (keys (%marked));
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };

  ($groups{$current}->{bkg_z}, $groups{$current}->{fft_edge})
    = find_edge($groups{$current}->{bkg_e0});
  my %cal_params = (cal_to => Xray::Absorption->get_energy($groups{$current}->{bkg_z},
							   $groups{$current}->{fft_edge}),
		    e0 => $groups{$current}->{bkg_e0},
		    display => "deriv(E)",
		    iterations => 0,
		   );
 SWITCH: {
    $cal_params{display} = 'mu(E)',        last SWITCH if ($config{calibrate}{calibrate_default} eq 'x');
    $cal_params{display} = 'norm(E)',      last SWITCH if ($config{calibrate}{calibrate_default} eq 'n');
    $cal_params{display} = 'deriv(E)',     last SWITCH if ($config{calibrate}{calibrate_default} eq 'd');
    $cal_params{display} = 'second deriv', last SWITCH if ($config{calibrate}{calibrate_default} eq '2');
  };

  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{calibrate}{emin};
  $plot_features{emax} = $config{calibrate}{emax};
  project_state($ps);		# don't toggle if currently saved

  $fat_showing = 'calibrate';
  $hash_pointer = \%cal_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $cal = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$cal -> packPropagate(0);
  $which_showing = $cal;


  $cal -> Label(-text=>"Data calibration",
		-font=>$config{fonts}{large},
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## select the data set to calibrate
  my $frame = $cal -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -padx=>8);
  $frame -> Label(-text=>"Group: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widget{cal_group} = $frame -> Label(-text=>$groups{$current}->{label},
				       -foreground=>$config{colors}{button})
    -> grid(-row=>0, -column=>1, -sticky=>'w', -padx=>3);


  $cal -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');
  $cal -> Button(-text=>'Return to the main window',  @button_list,
		 -background=>$config{colors}{background2},
		 -activebackground=>$config{colors}{activebackground2},
		 -command=>sub{set_properties(1, $current, 0);
			       reset_window($cal, "calibration", \@save);
			     })
    -> pack(-side=>'bottom', -fill=>'x');

  ## help button
  $cal -> Button(-text=>'Document section: energy calibration', @button_list,
		   -command=>sub{pod_display("process::cal.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  # pick display mode (mu, norm, deriv)
  #$frame = $cal -> Frame(-borderwidth=>2, -relief=>'sunken')
  #  -> pack(-fill=>'x');
  $frame -> Label(-text=>"Display: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $widget{display} = $frame -> Optionmenu(-textvariable => \$cal_params{display},
					  -borderwidth=>1,
					  -options => [qw(mu(E) norm(E) deriv(E)), 'second deriv'],
					  -command => sub{
					    $widget{calib_zero} -> configure(-state=>($cal_params{display} eq 'second deriv') ? 'normal' : 'disabled');
					    my $str = 'em';
					    ($str = 'emn') if ($cal_params{display} eq 'norm(E)');
					    ($str = 'emd') if ($cal_params{display} eq 'deriv(E)');
					    ($str = 'em2') if ($cal_params{display} eq 'second deriv');
					    $str .= 's' x $cal_params{iterations};
					    $cal_params{str} = $str;
					    $plot_features{suppress_markers} = 1;
					    $groups{$current}->plotE($str, $dmode, \%plot_features, \@indicator);
					    $plot_features{suppress_markers} = 0;
					    &cal_marker($current, $cal_params{e0}, $cal_params{str});
					  } )
    -> grid(-row=>1, -column=>1, -sticky =>'w', -padx=>3);

  $frame -> Label(-text=>'Smoothing: ',
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $frame -> NumEntry(-width	   => 4,
		     -orient	   => 'horizontal',
		     -foreground   => $config{colors}{foreground},
		     -textvariable => \$cal_params{iterations},
		     -minvalue	   => 0,
		     -browsecmd	   => sub{ $widget{calib_replot}->invoke },
		     -command	   => sub{ $widget{calib_replot}->invoke },
		    )
    -> grid(-row=>2, -column=>1, -sticky =>'w', -padx=>3);
  $frame -> Label(-text=>'Reference at: ',
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $frame -> Entry(-textvariable=> \$cal_params{e0}, -width=>12)
    -> grid(-row=>3, -column=>1, -sticky =>'w', -padx=>3);
  $frame -> Label(-text=>'Calibrate to: ',
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $frame -> Entry(-textvariable=> \$cal_params{cal_to}, -width=>12)
    -> grid(-row=>4, -column=>1, -sticky =>'w', -padx=>3);

  ## pluck button
  $widget{calib_select} =
    $frame -> Button(-text=>'Select a point', @button_list,
		     -command=>sub{
		       Error("Calibration selection aborted: " .
			     $groups{$current}->{label} . " is not an xmu group."),
			       return unless ($groups{$current}->{is_xmu});
		       $cal_params{e0} = &cal_pluck($current, $cal_params{str});
		       my $str = 'em';
		       ($str = 'emn') if ($cal_params{display} eq 'norm(E)');
		       ($str = 'emd') if ($cal_params{display} eq 'deriv(E)');
		       ($str = 'em2') if ($cal_params{display} eq 'second deriv');
		       $str .= 's' x $cal_params{iterations};
		       $cal_params{str} = $str;
		       $plot_features{suppress_markers} = 1;
		       $groups{$current}->plotE($str, $dmode, \%plot_features, \@indicator);
		       $plot_features{suppress_markers} = 0;
		       &cal_marker($current, $cal_params{e0}, $cal_params{str});
		       Echo("You chose $cal_params{e0}");
		     })
    -> grid(-row=>5, -column=>0, -columnspan=>2, -sticky=>'we');

  $widget{calib_zero} =
    $frame -> Button(-text=>'Find zero-crossing', @button_list,
		     -state=>'disabled',
		     -command=>sub{cal_zero($current, \%cal_params)},
		    )
    -> grid(-row=>6, -column=>0, -columnspan=>2, -sticky=>'we');

  ## replot button
  $widget{calib_replot} =
    $frame -> Button(-text=>'Replot', @button_list,
		     -command=>sub{
		       Error("Replot aborted: " .
			     $groups{$current}->{label} . " is not an xmu group."),
			       return unless ($groups{$current}->{is_xmu});
		       my $str = 'em';
		       ($str = 'emn') if ($cal_params{display} eq 'norm(E)');
		       ($str = 'emd') if ($cal_params{display} eq 'deriv(E)');
		       ($str = 'em2') if ($cal_params{display} eq 'second deriv');
		       $str .= 's' x $cal_params{iterations};
		       ##print $str, $/;
		       $cal_params{str} = $str;
		       $plot_features{suppress_markers} = 1;
		       $groups{$current}->plotE($str, $dmode, \%plot_features, \@indicator);
		       $plot_features{suppress_markers} = 0;
		       &cal_marker($current, $cal_params{e0}, $cal_params{str});
		       Echo("Replotted $groups{$current}->{label}");
		     })
      -> grid(-row=>7, -column=>0, -columnspan=>2, -sticky=>'we');

  ## calibrate button
  $widget{calib_calibrate} =
    $frame -> Button(-text=>'Calibrate', @button_list,
		     -command=>sub{
		       Echo("Calibration aborted: \"$groups{$current}->{label}\" is frozen"), return
			 if $groups{$current}->{frozen};
		       Error("Calibration aborted: " .
			     $groups{$current}->{label} . " is not an xmu group."),
			       return unless ($groups{$current}->{is_xmu});
		       my $delta = $cal_params{cal_to} - $cal_params{e0};
		       $cal_params{e0} = $cal_params{cal_to};
		       $groups{$current}->{bkg_eshift} += $delta;
		       $groups{$current}->{bkg_eshift} = sprintf("%.4f", $groups{$current}->{bkg_eshift});
		       if ($groups{$current}->{reference} and exists $groups{$groups{$current}->{reference}}) {
			 $groups{$groups{$current}->{reference}}->make(bkg_eshift=>$groups{$current}->{bkg_eshift});
			 $groups{$groups{$current}->{reference}}->make(bkg_e0=>$groups{$groups{$current}->{reference}}->{bkg_e0}+$groups{$current}->{bkg_eshift});
		       };
		       $groups{$current}->{bkg_e0}      = $cal_params{e0};
		       $groups{$current} -> make(update_bkg=>1);
		       my $str = 'em';
		       ($str = 'emn') if ($cal_params{display} eq 'norm(E)');
		       ($str = 'emd') if ($cal_params{display} eq 'deriv(E)');
		       ($str = 'em2') if ($cal_params{display} eq 'second deriv');
		       $str .= 's' x $cal_params{iterations};
		       $cal_params{str} = $str;
		       $plot_features{suppress_markers} = 1;
		       $groups{$current}->plotE($str, $dmode, \%plot_features, \@indicator);
		       $plot_features{suppress_markers} = 0;
		       &cal_marker($current, $cal_params{e0}, $cal_params{str});
		       $groups{$current}->make(update_bkg=>1);
		       project_state(0);
		       Echo("Calibrated to $cal_params{cal_to}");
		     })
      -> grid(-row=>8, -column=>0, -columnspan=>2, -sticky=>'we');


  $widget{calib_zero} -> configure(-state=>($cal_params{display} eq 'second deriv') ? 'normal' : 'disabled');
  $groups{$current} -> dispose("set $current.deriv = deriv($current.xmu)/deriv($current.energy)\n", $dmode);
  my $str = 'em';
  ($str = 'emn') if ($cal_params{display} eq 'norm(E)');
  ($str = 'emd') if ($cal_params{display} eq 'deriv(E)');
  ($str = 'em2') if ($cal_params{display} eq 'second deriv');
  $str .= 's' x $cal_params{iterations};
  $cal_params{str} = $str;
  $plot_features{suppress_markers} = 1;
  $groups{$current}->plotE($str, $dmode, \%plot_features, \@indicator);
  $plot_features{suppress_markers} = 0;
  &cal_marker($current, $cal_params{e0}, $cal_params{str});
  $plotsel -> raise('e');
  $top -> update;
};



sub cal_pluck {
  my ($group, $str) = @_;
  Error("Calibration display aborted: " . $groups{$group}->{label} . " is not an xmu group."),
    return unless ($groups{$group}->{is_xmu});
  Echonow("Select a point from the plot");
  $groups{$group} -> dispose('cursor(crosshair=true)', 1);
  my ($xx, $yy) = (Ifeffit::get_scalar('cursor_x'), Ifeffit::get_scalar('cursor_y'));
  return sprintf("%.3f", $xx);
};

## show the edge energy marker in a calibration plot, take care to
## deal well with derivative
sub cal_marker {
  my ($g, $e, $str) = @_;
  Error("Calibration display aborted: " . $groups{$g}->{label} . " is not an xmu group."),
    return unless ($groups{$g}->{is_xmu});
  my $command = "";
  my $xarr = "\"$g.energy+$groups{$g}->{bkg_eshift}\"";

  if ($str =~ /(s+)/) {
    my $iterations = length($1);
    my $suff = 'xmu';
    if ($groups{$g}->{not_data}) {
      $suff = 'det';
    } elsif ($str =~ /n/) {
      $suff = 'norm';
    };
    $groups{$g}->dispose("set $g.smooth = $g.$suff", $dmode);
    foreach (1 .. $iterations) {
      $groups{$g}->dispose("set $g.smooth = smooth($g.smooth)", $dmode);
    };
  };

  my $suff = "xmu";
  ($str =~ /n/) and ($suff = "norm");
  ($str =~ /s/) and ($suff = "smooth");
  ($str =~ /d/) and ($suff = "deriv");
  if ($str =~ /2/) {
    $command .= "set $g.second = deriv($g.deriv)/deriv($g.energy)\n";
    $suff = "second";
  };
  my $yarr = "$g.$suff";
  my $yoff = $groups{$g}->{plot_yoffset};

  $command .= "pmarker $xarr, $yarr, $e, $plot_features{marker}, $plot_features{markercolor}, $yoff\n";
  ##($str =~ /^d/) and ($command .= "erase $g.deriv\n");

  $groups{$g} -> dispose($command, $dmode);
  $last_plot='e';
};

sub cal_zero {
  my ($g, $r_hash) = @_;
  my $str = $$r_hash{str};
  $$r_hash{zero_skip_plot} ||= 0;
  my $suff = 'xmu';
  if ($groups{$g}->{not_data}) {
    $suff = 'det';
  } elsif ($str =~ /n/) {
    $suff = 'norm';
  };
  if ($str =~ /(s+)/) {
    my $iterations = length($1);
    $groups{$g}->dispose("set $g.smooth = $g.$suff", $dmode);
    foreach (1 .. $iterations) {
      $groups{$g}->dispose("set $g.smooth = smooth($g.smooth)", $dmode);
    };
    $suff = 'smooth';
  };
  $groups{$g}->dispose("set($g.y = deriv($g.$suff)/deriv($g.energy), $g.y = deriv($g.y)/deriv($g.energy))\n", $dmode);

  my @x = map {$_ + $groups{$g}->{bkg_eshift}} Ifeffit::get_array("$g.energy");
  my @y = Ifeffit::get_array("$g.y");

  my $e0index = 0;
  foreach my $e (@x) {
    last if ($e > $$r_hash{e0});
    ++$e0index;
  };
  my ($enear, $ynear) = ($x[$e0index], $y[$e0index]);
  my ($ratio, $i) = (1, 1);
  my ($above, $below) = (0,0);
  while (1) {			# find points that bracket the zero crossing
    (($above, $below) = (0,0)), last unless (exists($y[$e0index + $i]) and $y[$e0index]);
    $ratio = $y[$e0index + $i] / $y[$e0index]; # this ratio is negative for a points bracketing the zero crossing
    ($above, $below) = ($e0index+$i, $e0index+$i-1);
    last if ($ratio < 0);
    (($above, $below) = (0,0)), last unless exists($y[$e0index - $i]);
    $ratio = $y[$e0index - $i] / $y[$e0index]; # this ratio is negative for a points bracketing the zero crossing
    ($above, $below) = ($e0index-$i+1, $e0index-$i);
    last if ($ratio < 0);
    ++$i;
    Error("Could not find zero crossing."), return 0 if ($i == 4000);
  };
  Error("Could not find zero crossing."), return if (($above == 0) and ($below == 0));

  ## linearly interpolate between points that bracket the zero crossing
  $$r_hash{e0} = sprintf("%.3f", $x[$below] - ($y[$below]/($y[$above]-$y[$below])) * ($x[$above] - $x[$below]));
  return if $$r_hash{zero_skip_plot};

  $plot_features{suppress_markers} = 1;
  $groups{$current}->plotE($$r_hash{str}, $dmode, \%plot_features, \@indicator);
  $plot_features{suppress_markers} = 0;
  &cal_marker($current, $$r_hash{e0}, $$r_hash{str});

  $groups{$g}->dispose("erase $g.y $g.smooth", $dmode);
  Echo("Found zero crossing at $$r_hash{e0} in group \"$groups{$g}->{label}\".");
};



## END OF DATA CALIBRATION SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  data deglitching

sub choose_a_point {
  my $group = $_[1];
  my $space = $_[2];
  Error("Point selection aborted: " . $groups{$group}->{label} . " is not an xmu group."),
	  return unless ($groups{$current}->{is_xmu});
  Echonow("Select a point by clicking on the plot");
  my ($yoffset, $kw, $plot_scale) = ($groups{$group}->{plot_yoffset},
				     $groups{$group}->{fft_kw},
				     $groups{$group}->{plot_scale});
  my (@x, @y);
  if ($space eq 'emg') {
    $plot_features{linestyle} = "linespoints3";
    $groups{$group} -> plotE('em',$dmode,\%plot_features, \@indicator);
    $plot_features{linestyle} = "lines";
    @x = Ifeffit::get_array($group.".energy");
    @y = Ifeffit::get_array($group.".xmu");
    $groups{$group} -> dispose("set(___y = ceil($group.xmu), ___z = floor($group.xmu))");
    $last_plot = 'e';
  } else {
    &plot_chie($group,1);
    @x = Ifeffit::get_array($group.".energy");
    @y = Ifeffit::get_array($group.".chie");
    $groups{$group} -> dispose("set(___y = ceil($group.chie), ___z = floor($group.chie))");
    $last_plot = 'e';
  };
  my $maxy = Ifeffit::get_scalar('___y');
  my $miny = Ifeffit::get_scalar('___z');
  $groups{$group} -> dispose('cursor(crosshair=true)', 1);
  my ($xx, $yy) = (Ifeffit::get_scalar('cursor_x'), Ifeffit::get_scalar('cursor_y'));
  my ($dist, $ii) = (1e10, -1);
  foreach my $i (0 .. $#x) {	# need to scale these appropriately
    #my $px = ($x[$i] - $x[0])/($x[$#x] - $x[0]);
    #my $py = ($y[$i] - $y[0])/($y[$#y] - $y[0]);
    #my $xn = ($xx    - $x[0])/($x[$#x] - $x[0]);
    #my $yn = ($yy    - $y[0])/($y[$#y] - $y[0]);
    #my $d = sqrt(($px - $xn)**2 + ($py - $yn)**2);

    #print join(" ", $px, $py, $xn, $yn, $d), $/;

    my $px = ($x[$i] - $xx)/($x[-1] - $x[0]);
    ##my $py = ($y[$i] - $yy)/($y[$#y] - $y[0]);
    my $py = ($y[$i] - $yy)/($maxy - $miny);
    my $d  = sqrt($px**2 + $py**2);
    #print join(" ", $px, $py, $d), $/;

    ($d < $dist) and ($dist, $ii) = ($d, $i);
  };
  if ($space eq 'emg') {
    $groups{$group} -> dispose("pmarker $group.energy, $group.xmu, $x[$ii], " .
			       "$plot_features{marker}, $plot_features{markercolor}, $yoffset", $dmode);
  } else {
    $groups{$group} -> dispose("pmarker $group.energy, $group.chie, $x[$ii], " .
			       "$plot_features{marker}, $plot_features{markercolor}, $yoffset", $dmode);
  };
  #$_[0]->raise;
  Echo("You selected (" . sprintf("%.3f", $x[$ii]) . ", " . sprintf("%.5f", $y[$ii]) . ").");

  return $ii;
};


sub deglitch_a_point {
  my $ii = $_[0];
  my $group = $_[1];
  my $space = $_[2];
  Echo("Point -1?"), return if ($ii < 0);
  my @x = Ifeffit::get_array($group.".energy");
  my @y = Ifeffit::get_array($group.".xmu");
  my $str = "Removed point $ii at x=$x[$ii], y=$y[$ii]";
  splice(@x, $ii, 1);
  splice(@y, $ii, 1);
  Ifeffit::put_array($group.".energy", \@x);
  Ifeffit::put_array($group.".xmu", \@y);
  $groups{$group} -> make(update_bkg=>1);
  if ($space eq 'emg') {
    $groups{$group} -> plotE($space,$dmode,\%plot_features, \@indicator);
    $last_plot = 'e';
  } else {
    &plot_chie($group,0);
    $last_plot = 'e';
  };
  project_state(0);
  &refresh_properties;
  Echo($str);
};


sub deglitch_palette {
  Echo("You must select a data group to deglitch"), return
    if ($current eq "Default Parameters");
  Echo("No data!"), return unless $current;

  my %degl_params;
  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };
  Echo("You need at least one group to deglitch"), return unless (@keys);
  $degl_params{standard} = ($groups{$current}->{is_xmu}) ? $current : $keys[0];
  $groups{$degl_params{standard}}->dispatch_bkg if $groups{$degl_params{standard}}->{update_bkg};
  $degl_params{standard_label} = $groups{$degl_params{standard}}->{label};
  $degl_params{deg_emin} = $groups{$degl_params{standard}}->{bkg_nor1} +
    $groups{$degl_params{standard}}->{bkg_e0};
  $groups{$degl_params{standard}} ->
    dispose("set ___x = ceil($degl_params{standard}.energy)\n", 1);
  my $maxE = Ifeffit::get_scalar("___x");
  $degl_params{deg_emax} = $config{deglitch}{emax} ? $maxE+$config{deglitch}{emax} : $maxE*1.1;
  $degl_params{deg_emin} = sprintf("%.3f",$degl_params{deg_emin});
  $degl_params{deg_emax} = sprintf("%.3f",$degl_params{deg_emax});
  $degl_params{deg_tol} = sprintf("%.4f", $groups{$degl_params{standard}}->{bkg_step} * $config{deglitch}{margin});
  $degl_params{space} = 'emg';
  $degl_params{space_label} = 'mu(E)';
  my @save = ($plot_features{emin}, $plot_features{emax});

  set_deglitch_params(\%degl_params);

  my $point_choice = -1;

  $fat_showing = 'deglitch';
  $hash_pointer = \%degl_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $degl = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$degl -> packPropagate(0);
  $which_showing = $degl;

  $degl -> Label(-text=>"Deglitch data",
		 -font=>$config{fonts}{large},
		 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## which group ...?
  my $fr = $degl -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -pady=>8, -fill=>'x');
  my $frame = $fr -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-pady=>1, -fill=>'x');
  $frame -> Label(-text=>"Group: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> pack(-side=>'left', -anchor=>'e', -fill=>'x');
  $widget{deg_group} = $frame -> Label(-text=>$groups{$current}->{label},
				       -foreground=>$config{colors}{button})
    -> pack(-side=>'left', -anchor=>'w', -fill=>'x');


  ## this frame has all the active elements
  $frame = $fr -> LabFrame(-label=>'Deglitch a single point',
			   -foreground=>$config{colors}{activehighlightcolor},
			   -labelside=>'acrosstop')
    -> pack(-pady=>3, -padx=>3, -ipady=>3, -ipadx=>3, -fill=>'x');

  my $upper = $frame -> Frame ()
    -> pack(-side=>'top');
  $upper -> Label(-text=>'Plot as:',
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> pack(-side=>'left');
  my $menu = $upper -> Optionmenu(-textvariable => \$degl_params{space_label},
				  -borderwidth=>1,
				  -width=>12, -justify=>'right')
    -> pack(-side=>'left');
  foreach my $sp ('mu(E)', 'chi(E)') {
    my $how = 'emg';
    ($how = 'k' . $plot_features{k_w} . 'e') if ($sp eq 'chi(E)');
    $menu -> command(-label => $sp,
		     -command=>sub{$degl_params{space} = $how;
				   $degl_params{space_label} = $sp;
				   set_deglitch_params(\%degl_params);
				   if ($degl_params{space} eq 'emg') {
				     $plot_features{emin} = $save[0];
				     $groups{$degl_params{standard}} -> plotE($degl_params{space},$dmode,\%plot_features, \@indicator);
				     $last_plot = 'e';
				     map {$widget{"deg_$_"}->configure(-state=>'normal')} (qw(tol emin emax replot remove));
				     map {$grab{"deg_$_"}  ->configure(-state=>'normal')} (qw(emin emax));
				   } else {
				     $plot_features{emin} = $config{deglitch}{chie_emin};
				     &plot_chie($degl_params{standard},0);
				     #$groups{$degl_params{standard}} -> plotk($degl_params{space},$dmode,\%plot_features, \@indicator);
				     $last_plot = 'e';
				     map {$widget{"deg_$_"}->configure(-state=>'disabled')} (qw(tol emin emax replot remove));
				     map {$grab{"deg_$_"}  ->configure(-state=>'disabled')} (qw(emin emax));
				   };
				   $top -> update;});
  };


  my $fr1 = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-expand=>1, -fill=>'x');
  my $help = "Choose a point with the cursor, then press the \"Remove\" button to delete it";
  $fr1 -> Button(-text=>"Help", @button_list,
		   -width=>1,
		   -command=>[\&Echo, $help])
    -> pack(-side=>'right', -expand=>1, -fill=>'x');
  $widget{deg_sreplot} = $fr1 -> Button(-text=>"Replot", @button_list,
					  -width=>1,
					  -command=>sub{
					    if ($degl_params{space} eq 'emg') {
					      $groups{$current} -> plotE('emg',$dmode,\%plot_features, \@indicator);
					    } else {
					      &plot_chie($current,0);
					    };
					  })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $widget{deg_point} = $fr1 -> Button(-text=>"Remove point", @button_list,
				      -width=>1,
				      -command=>sub{Echo("Deglitching aborted: \"$groups{$current}->{label}\" is frozen"), return
						      if $groups{$current}->{frozen};
						    &deglitch_a_point($point_choice, $degl_params{standard},  $degl_params{space});
						    $widget{deg_point}->configure(-state=>'disabled');
						    #$degl->raise;
						    $top -> update;
						  },
				      -state=>'disabled')
    -> pack(-side=>'right', -expand=>1, -fill=>'x');
  $widget{deg_single} = $fr1 -> Button(-text=>"Choose a point", @button_list,
					 -width=>1,
					 -command=>sub{$point_choice = &choose_a_point($degl, $degl_params{standard}, $degl_params{space});
						       $widget{deg_point}->configure(-state=>'normal')})
    -> pack(-side=>'left', -expand=>1, -fill=>'x');

  $frame = $fr -> LabFrame(-label=>'Deglitch many points',
			   -foreground=>$config{colors}{activehighlightcolor},
			   -labelside=>'acrosstop')
    -> pack(-pady=>3, -padx=>3, -ipady=>3, -ipadx=>3, -fill=>'x');
  my $fr2 = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'bottom', -fill=>'x', -expand=>1);
  #$fr2 -> Label(-width=>1) -> pack(-side=>'left', -fill=>'x', -expand=>1);
  $fr2 -> Label(-text=>'Tolerance:',
		-foreground=>$config{colors}{activehighlightcolor},
	       )
    -> pack(-side=>'left');
  $widget{deg_tol} = $fr2 -> Entry(-textvariable=>\$degl_params{deg_tol}, -width=>7)
    -> pack(-side=>'left');
  $fr2 -> Label(-width=>1) -> pack(-side=>'left', -fill=>'x', -expand=>1);
  $fr2 -> Label(-text=>'Emin:',
		-foreground=>$config{colors}{activehighlightcolor},
	       )
    -> pack(-side=>'left');
  $widget{deg_emin} = $fr2 -> Entry(-textvariable=>\$degl_params{deg_emin},
				    -validate=>'key',
				    -validatecommand=>[\&set_variable, 'deg_emin'],
				    -width=>9)
    -> pack(-side=>'left');
  $grab{deg_emin} = $fr2 -> Button(@pluck_button, @pluck,
				   -command=>sub{Echo("\"$groups{$current}->{label}\" is frozen"), return
						   if $groups{$current}->{frozen};
						 &pluck('deg_emin');
						 $groups{$degl_params{standard}} -> plotE('emg',$dmode,\%plot_features, \@indicator);
						 $last_plot='e';
					       })
    -> pack(-side=>'left');
  $fr2 -> Label(-width=>1) -> pack(-side=>'left', -fill=>'x', -expand=>1);
  $fr2 -> Label(-text=>'Emax:',
		-foreground=>$config{colors}{activehighlightcolor},
	       )
    -> pack(-side=>'left');
  $widget{deg_emax} = $fr2 -> Entry(-textvariable=>\$degl_params{deg_emax},
				    -validate=>'key',
				    -validatecommand=>[\&set_variable, 'deg_emax'],
				    -width=>9)
    -> pack(-side=>'left');
  $grab{deg_emax} = $fr2 -> Button(@pluck_button, @pluck,
				  -command=>sub{Echo("\"$groups{$current}->{label}\" is frozen"), return
						  if $groups{$current}->{frozen};
						&pluck('deg_emax');
						$groups{$degl_params{standard}} -> plotE('emg',$dmode,\%plot_features, \@indicator);
						$last_plot='e';
					      })
    -> pack(-side=>'left');
  #$fr2 -> Label(-width=>1) -> pack(-side=>'left', -fill=>'x', -expand=>1);

  $fr2 = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-expand=>1, -fill=>'x');
  $widget{deg_replot} =
    $fr2 -> Button(-text=>'Replot', @button_list,
		   -width=>1,
		   -command=> sub{set_deglitch_params(\%degl_params);
				  $groups{$degl_params{standard}} -> plotE('emg',$dmode,\%plot_features, \@indicator);
				  $last_plot = 'e'; $top -> update;})
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $widget{deg_remove} =
    $fr2 -> Button(-text=>'Remove glitches', @button_list,
		   -width=>1,
		   -command=>sub{Echo("Deglitching aborted: \"$groups{$current}->{label}\" is frozen"), return
				   if $groups{$current}->{frozen};
				 &remove_glitches($degl_params{standard});
				 $top -> update;
			       })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $fr2 -> Button(-text=>"Help", @button_list,
		 -width=>1,
		 -command=>[\&Echo, "Remove all points which fall outside the tolerance margins defined by the parameters below"])
    -> pack(-side=>'left', -expand=>1, -fill=>'x');

  ## help button
  $degl -> Button(-text=>'Document section: deglitching data', @button_list,
		  -command=>sub{pod_display("process::deg.pod")})
    -> pack(-fill=>'x', -pady=>4);

  $degl -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{&reset_window($degl, "deglitching", \@save)})
    -> pack(-fill=>'x');
  $degl -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-expand=>1, -fill=>'both');

  ($groups{$degl_params{standard}}->{update_bkg}) and $groups{$degl_params{standard}}->dispatch_bkg($dmode);
  $groups{$degl_params{standard}} -> plotE('emg',$dmode,\%plot_features, \@indicator);
  $last_plot = 'e';
  $plotsel -> raise('e');
  $top -> update;
};



sub set_deglitch_params {
  my $hash_pointer = $_[0];
  my $standard = $$hash_pointer{standard};
  ## set deg_emin
  #my $emin = $widget{deg_emin} -> get;
  $groups{$standard} -> make(deg_emin=>$$hash_pointer{deg_emin} ||
			     $groups{$standard}->{bkg_nor1} + $groups{$standard}->{bkg_e0});
  ## set deg_emax
  #my $emax = $widget{deg_emax} -> get;
  $groups{$standard}->dispose("set ___x = ceil($standard.energy)\n", 1);
  my $maxE = Ifeffit::get_scalar("___x") * 1.1;
  $groups{$standard} -> make(deg_emax=>$$hash_pointer{deg_emax} || $maxE);
  ## set deg_tol
  #my $tol = $widget{deg_tol} -> get;
  $groups{$standard} -> make(deg_tol=>$$hash_pointer{deg_tol} ||
			     sprintf("%.4f", $groups{$standard}->{bkg_step} * $config{deglitch}{margin}));
};


sub remove_glitches {
  my $group  = $_[0];
  Error("Deglitching aborted: " . $groups{$group}->{label} . " is not an xmu group."),
	  return unless ($groups{$current}->{is_xmu});
  my $noplot = $_[1];
  my @e  = Ifeffit::get_array("$group.energy");
  my @ee = Ifeffit::get_array("$group.energy");
  my @x  = Ifeffit::get_array("$group.xmu");
  my $tol = $groups{$group}->{deg_tol};
  my $emin = $groups{$group}->{deg_emin};
  my $emax = $groups{$group}->{deg_emax};
  my @p;
  if ($emin > $groups{$group}->{bkg_e0}) {
    @p  = Ifeffit::get_array("$group.postline");
  } else {
    @p  = Ifeffit::get_array("$group.preline");
  };
  my ($i, $j) = (-1, 0);
  foreach (@ee) {
    ++$i;
    next if ($_ < $emin);
    next if ($_ > $emax);
    my ($up, $dn) = ($p[$i] + $tol, $p[$i] - $tol); ## bug here
    next if (($x[$i-$j] > $dn) and ($x[$i-$j] < $up));
    splice(@e, $i-$j, 1);
    splice(@x, $i-$j, 1);
    ++$j;
  };
  Ifeffit::put_array("$group.energy", \@e);
  Ifeffit::put_array("$group.xmu", \@x);
  $groups{$group}->make(update_bkg=>1);
  unless ($noplot) {
    ($groups{$group}->plotE('emtg',$dmode,\%plot_features, \@indicator));
    $last_plot='e';
    &refresh_properties;
  };
  project_state(0);
};


sub plot_chie {
  my $group = $_[0];
  my $how = $_[1];
  $groups{$group}->dispatch_bkg if $groups{$group}->{update_bkg};
  my $e0    = $groups{$group}->{bkg_e0};
  my $label = $groups{$group}->{label};
  my $emin  = $e0 + $plot_features{emin};
  my $emax  = $e0 + $plot_features{emax};
  my $style = ($how) ? 'linespoints3' : 'lines';
  my $command .= "set $group.chie = ($group.xmu-$group.bkg)*($group.energy-$e0)\n";
  $command    .= "newplot($group.energy, $group.chie,\n        ";
  $command    .= "xmin=$emin, xmax=$emax, xlabel=\"E (eV)\",\n        ";
  $command    .= "title=\"$label\",\n        ";
  $command    .= "ylabel=\"\\gx(E)\", fg=$config{plot}{fg}, bg=$config{plot}{bg},\n        ";
  $command    .= "style=$style, color=\"$config{plot}{c0}\", key=\"\\gm\")";
  $groups{$group} -> dispose($command, $dmode);

  if ($indicator[0]) {
    foreach my $i (@indicator) {
      next if ($i =~ /^[01]$/);
      next if (lc($i->[1]) =~ /[r\s]/);
      my $suff = "chie";
      my $val = $i->[2];
      ($val = $groups{$group}->k2e($val)+$groups{$group}->{bkg_e0})
	if (lc($i->[1]) =~ /[kq]/);
      next if ($val < 0);
      my $cmd = "set(___x = ceil($group.$suff+$groups{$group}->{plot_yoffset}),";
      $cmd   .= "    ___n = floor($group.$suff+$groups{$group}->{plot_yoffset}))";
      ifeffit($cmd);
      my $ymax = Ifeffit::get_scalar("___x") * 1.05;
      my $ymin = Ifeffit::get_scalar("___n");
      $groups{$group}->plot_vertical_line($val, $ymin, $ymax, $dmode, "", 0, 0, 1)
    };
  };


};



## END OF DATA DEGLITCHING SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2009 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  data truncation


sub truncate_palette {
  Echo("No data!"), return unless $current;
  Echo("You must select a data group to truncate"), return
    if ($current eq "Default Parameters");

  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };
  Echo("You need at least one xmu group to truncate"), return unless (@keys);
  my $group = $groups{$current}->{group};
  my @e = get_array("$group.energy");
  $groups{$current} -> make(etruncate=> $e[$#e]);
  my %trun_params = ( etruncate	  => sprintf("%.3f", $e[$#e]+0.001),
		      beforeafter => 'after',
		      plot	  => 'mu(E)' );
  $hash_pointer = \%trun_params;
  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emax} = int(1.1*($trun_params{etruncate} - $groups{$current}->{bkg_e0}));
  project_state($ps);		# don't toggle if currently saved

  $fat_showing = 'truncate';
  #$hash_pointer = \%trun_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $trun = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$trun -> packPropagate(0);
  $which_showing = $trun;

  $trun -> Label(-text=>"Data truncation",
		 -font=>$config{fonts}{large},
		 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  my $frame = $trun -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-ipadx=>3, -ipady=>3, -fill=>'x');
  my $fr = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-ipadx=>3, -ipady=>3, -side=>'top');
  $fr -> Label(-text=>"Group:",
	       -foreground=>$config{colors}{activehighlightcolor},
	      )
    -> pack(-side=>'left');
  $widget{trun_group} = $fr -> Label(-text=>$groups{$current}->{label},
				     -foreground=>$config{colors}{button})
    -> pack(-side=>'right');


  $fr = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -ipady=>3);

  my $fr2 = $fr -> Frame(-borderwidth=>2, -relief=>'flat') -> pack();
  $fr2 -> Label(-text=>'Drop points ',
		-foreground=>$config{colors}{activehighlightcolor},
	       )
    -> pack(-side=>'left');
  $fr2 -> Optionmenu(-variable=>\$trun_params{beforeafter},
		     -textvariable=>\$trun_params{beforeafter},
		     -borderwidth=>1,
		     -options=>['before', 'after'],
		     )
     -> pack(-side=>'left');
  $fr2 -> Label(-text=>' E =',
		-foreground=>$config{colors}{activehighlightcolor},
	       )
    -> pack(-side=>'left');
  $widget{etruncate} = $fr2 -> RetEntry(-textvariable=>\$trun_params{etruncate},
					-command=>sub{$widget{trun_replot}->invoke},
					-width=>10)
    -> pack(-side=>'left');
  $grab{etruncate} = $fr2 -> Button(@pluck_button, @pluck,
				    -command=>
				    sub{Echo("\"$groups{$current}->{label}\" is frozen"), return
					  if $groups{$current}->{frozen};
					&pluck('etruncate');
					$groups{$current} -> make(etruncate=>
								  $widget{etruncate}->get());
					my $str;
					map {$str .= $plot_features{$_}} (qw/e_mu e_norm e_der/);
					($str eq "e")  and ($str = "em");
					($str eq "en") and ($str = "emn");
					($str eq "ed") and ($str = "emd");
					$groups{$current} -> plotE($str,$dmode,\%plot_features, \@indicator);
					$last_plot = 'e';
					my $e = $groups{$current}->{etruncate};
					my $suff = ($str =~ /n/) ? 'norm' : 'xmu';
					($suff = 'flat') if (($str =~ /n/) and $groups{$current}->{bkg_flatten});
					my @x = Ifeffit::get_array("$current.energy");
					my @y = Ifeffit::get_array("$current.$suff");
					my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});
					$groups{$current} -> plot_vertical_line($e, $ymin, $ymax,
										$dmode, "truncate",
										$groups{$current}->{plot_yoffset});
					$trun_params{etruncate} = $groups{$current}->{etruncate};
				      })
    -> pack(-side=>'left');

  $widget{trun_replot} =
    $fr -> Button(-text=>'Replot', @button_list,
		  -width=>1,
		  -command=>sub{my $str;
				map {$str .= $plot_features{$_}} (qw/e_mu e_norm e_der/);
				($str eq "e")  and ($str = "em");
				($str eq "en") and ($str = "emn");
				($str eq "ed") and ($str = "emd");
				$groups{$current} -> plotE($str,$dmode,\%plot_features, \@indicator);
				$last_plot='e';
				my $g = $groups{$current}->{group};
				$groups{$current} -> make(etruncate=> $widget{etruncate}->get());
				my $e = $groups{$current}->{etruncate};
				my $suff = ($str =~ /n/) ? 'norm' : 'xmu';
				($suff = 'flat') if (($str =~ /n/) and $groups{$current}->{bkg_flatten});
				my @x = Ifeffit::get_array("$current.energy");
				my @y = Ifeffit::get_array("$current.$suff");
				my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});
				$groups{$current} -> plot_vertical_line($e, $ymin, $ymax,
									$dmode, "truncate",
									$groups{$current}->{plot_yoffset});
			      })
    -> pack(-expand=>1, -fill=>'x');

  $widget{trun_truncate} =
    $fr -> Button(-text=>'Truncate data', @button_list,
		  -width=>1,
		  -command=>sub{Echo("Truncation aborted: \"$groups{$current}->{label}\" is frozen"), return
				  if $groups{$current}->{frozen};
				&truncate_data($current,0,$trun_params{beforeafter});
				$widget{trun_replot} -> invoke;
				$top -> update;})
      -> pack(-expand=>1, -fill=>'x');
  $widget{trun_truncate} =
    $fr -> Button(-text=>'Truncate marked groups', @button_list,
		  -width=>1,
		  -command=>sub{
		    Echo("Truncating marked groups ...");
		    $top -> Busy;
		    my $restore = $current;
		    foreach my $g (&sorted_group_list) {
		      next unless $marked{$g};
		      next if $groups{$g}->{frozen};
		      set_properties(0, $g, 0);
		      &truncate_data($current,0,$trun_params{beforeafter});
		      $widget{trun_replot} -> invoke;
		    };
		    set_properties(1, $restore, 0);
		    $top -> Unbusy;
		    Echo("Truncating marked groups ... done!");
		    $top -> update;
		  })
      -> pack(-expand=>1, -fill=>'x');


  ## help button
  $trun -> Button(-text=>'Document section: truncating data', @button_list,
		  -command=>sub{pod_display("process::trun.pod")})
    -> pack(-fill=>'x', -pady=>4);

  $trun -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{&reset_window($trun, "truncation", \@save)}
		 )
    -> pack(-fill=>'x');
  $trun -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-expand=>1, -fill=>'both');

  my $str;
  map {$str .= $plot_features{$_}} (qw/e_mu e_norm e_der/);
  ($str eq "e")  and ($str = "em");
  ($str eq "en") and ($str = "emn");
  ($str eq "ed") and ($str = "emd");
  $groups{$current} -> plotE($str,$dmode,\%plot_features, \@indicator);
  my $e = $groups{$current}->{etruncate};
  my $suff = ($str =~ /n/) ? 'norm' : 'xmu';
  ($suff = 'flat') if (($str =~ /n/) and $groups{$current}->{bkg_flatten});
  my @x = Ifeffit::get_array("$current.energy");
  my @y = Ifeffit::get_array("$current.$suff");
  my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});
  $groups{$current} -> plot_vertical_line($e, $ymin, $ymax, $dmode, "truncate",
					  $groups{$current}->{plot_yoffset});
  $last_plot='e';
  $plotsel -> raise('e');
  $top -> update;
};


sub truncate_data {
  my $g = $_[0];
  Error("Truncation aborted: " . $groups{$g}->{label} . " is not an xmu group."),
    return unless ($groups{$g}->{is_xmu});
  my $etrun = $groups{$g}->{etruncate};
  my $noplot = $_[1];
  my $beforeafter = $_[2];
  my @x  = Ifeffit::get_array("$g.energy");
  my @y  = Ifeffit::get_array("$g.xmu");
  my @i0 = Ifeffit::get_array($groups{$g}->{i0});
  my $is_i0 = ($#i0 > 0) ? 1 : 0;
  if (($etrun < $x[0]) or ($etrun > $x[-1])) {
    Echo("Truncation aborted: truncation energy is outside the data range for $groups{$g}->{label}");
    return;
  };
  #my (@newx, @newy);
  my $last = 0;
  foreach (0 .. $#x) {
    $last = $_ -1, last if ($x[$_] > $etrun);
    #$newx[$_] = $x[$_];
    #$newy[$_] = $y[$_];
    #print "$g  $etrun  $x[$_]\n";
  };
  if ($beforeafter eq 'after') {
    $#x  = $last;
    $#y  = $last;
    $#i0 = $last if $is_i0;
  } else {
    @x  = @x[ $last+1 .. $#x];
    @y  = @y[ $last+1 .. $#y];
    @i0 = @i0[$last+1 .. $#i0] if $is_i0;
  };
  #$groups{$g}->dispose("erase $g.energy", $dmode);
  #$groups{$g}->dispose("erase $g.xmu", $dmode);
  Ifeffit::put_array("$g.energy", \@x);
  Ifeffit::put_array("$g.xmu", \@y);
  Ifeffit::put_array($groups{$g}->{i0}, \@i0) if $is_i0;
  #$groups{$g}->dispose("show $g.energy", $dmode);

  ## reset the various range parameters
  my ($pre1, $pre2, $nor1, $nor2, $spl1, $spl2, $kmin, $kmax) =
    set_range_params($g);
  my $e0 = $groups{$g}->{bkg_e0};
  if ($beforeafter eq 'after') {
    $groups{$g}->dispose("set ___x = ceil($g.energy)\n");
    my $maxe = Ifeffit::get_scalar("___x");
    $groups{$g} -> make(bkg_nor1   => $nor1,
			update_bkg => 1) if ($maxe < $groups{$g}->{bkg_nor1}+$e0);
    $groups{$g} -> make(bkg_nor2   => $nor2,
			update_bkg => 1) if ($maxe < $groups{$g}->{bkg_nor2}+$e0);
    $groups{$g} -> make(bkg_spl1   => $spl1,
			bkg_spl1e  => $groups{$g}->k2e($spl1),
			update_bkg => 1) if ($maxe < $groups{$g}->{bkg_spl1e}+$e0);
    $groups{$g} -> make(bkg_spl2   => $spl2,
			bkg_spl2e  => $groups{$g}->k2e($spl2),
			update_bkg => 1) if ($maxe < $groups{$g}->{bkg_spl2e}+$e0);
    $groups{$g} -> make(fft_kmax   => $kmax,
			update_fft => 1) if ($groups{$g}->e2k($maxe) > $groups{$g}->{fft_kmax});
  } else {
    $groups{$g}->dispose("set ___x = floor($g.energy)\n");
    my $mine = Ifeffit::get_scalar("___x");
    $groups{$g} -> make(bkg_pre1   => $pre1,
			update_bkg => 1) if ($mine >  $groups{$g}->{bkg_pre1}+$e0);
    $groups{$g} -> make(bkg_pre2   => $pre2,
			update_bkg => 1) if ($mine >  $groups{$g}->{bkg_pre2}+$e0);
  };
  $groups{$g} -> kmax_suggest(\%plot_features) if ($groups{$g}->{fft_kmax} == 999);
  unless ($noplot) {
    my $str;
    map {$str .= $plot_features{$_}} (qw/e_mu e_norm e_der/);
    ($str eq "e")  and ($str = "em");
    ($str eq "en") and ($str = "emn");
    ($str eq "ed") and ($str = "emd");
    $groups{$g} -> plotE($str,$dmode,\%plot_features, \@indicator);
    $last_plot='e';
  };
  project_state(0);
};



## END OF DATA TRUNCATION SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2009 Bruce Ravel


## possible features:
##  * plot buttons for E, k , R
##  * checkbutton for constraining phi+theta=90
##  * weight percentages in formula


sub sa {

  ## do not change modes unless there is xmu data
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my @keys = ();
  foreach my $k (&sorted_group_list) {
    (($groups{$k}->{is_xmu}) or ($groups{$k}->{is_chi})) and push @keys, $k;
  };
  Error("You need at least one xmu or chi group to do self-absorption corrections"), return unless (@keys);

  #$top -> Busy;

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the $hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters, as in the commented out
  ## example
  my %safluo_params = (angle_in  => $config{sa}{angle_in},
		       angle_out => $config{sa}{angle_out},
		       formula   => "",
		       thickness => $config{sa}{thickness},
		       algorithm => $config{sa}{algorithm});
  my %explain = (fluo   => "Correct XANES spectra, mu(E), and EXAFS, chi(k).  The sample is presumed to be infinitely thick.",
		 booth  => "Correct EXAFS spectra, chi(k), for samples of any thickness.",
		 troger => "Correct EXAFS spectra, chi(k), but only for thick samples.",
		 atoms  => "Correct EXAFS spectra, chi(k), using corrections to S0^2 and sigma^2, but only for thick samples.",
		);
  my $grey  = $config{colors}{disabledforeground};
  my $black = $config{colors}{foreground};
  my $blue  = $config{colors}{activehighlightcolor};
  ## The Athena standard for analysis chores that need a specialized
  ## plotting range is to save the plotting range from the main view
  ## and restore it when the main view is restored
  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{sa}{emin};
  $plot_features{emax} = $config{sa}{emax};
  project_state($ps);		# don't toggle if currently saved

  ## these two global variables must be set before this view is
  ## displayed.  these are used at the level of set_properties to
  ## perform chores appropriate to this dialog when changing the
  ## current group
  $fat_showing = 'sa';
  $hash_pointer = \%safluo_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $safluo = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);

  ## global variable identifying which Frame is showing
  $which_showing = $safluo;

  ## the standard label along the top identifying this analysis chore
  $safluo -> Label(-text       => "Self Absorption Corrections",
		   -font       => $config{fonts}{large},
		   -foreground => $config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## a good solution to organizing widgets is to stack frames, so
  ## let's make a frame for the standard and the other.  note that the
  ## "labels" are actually flat buttons which display hints in the
  ## echo area
  my $top = $safluo -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x');
  my $frame = $top -> LabFrame(-label	   => 'Algorithm',
			       -foreground => $config{colors}{activehighlightcolor},
			       -labelside  => 'acrosstop')
    -> pack(-side=>'left', -fill=>'both', -expand=>1);
  $widget{safluo_fluo} = $frame -> Radiobutton(-text	     => 'XANES (Fluo)',
					      -selectcolor => $config{colors}{single},
					      -foreground  => $config{colors}{activehighlightcolor},
					      -activeforeground  => $config{colors}{activehighlightcolor},
					      -command     => sub{$widget{safluo_thickness} -> configure(-state=>'disabled');
								  map { $widget{$_}->configure(-foreground=>$grey) } (qw(safluo_thickness safluo_thickness_lab safluo_thickness_lab2));
								  $widget{safluo_make} -> configure(-state=>'disabled');
								  $groups{$current}->plotE('emn', $dmode, \%plot_features, \@indicator)
								    if $groups{$current}->{is_xmu};
								  $last_plot = 'e';
								  $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
								  Echo($explain{fluo});
								},
					      -value	   => 'fluo',
					      -variable    => \$safluo_params{algorithm})
    -> pack(-side=>'top', -anchor=>'w', -padx=>2, -pady=>2);
  $frame -> Radiobutton(-text	     => 'EXAFS (Booth)',
			-selectcolor => $config{colors}{single},
			-foreground  => $config{colors}{activehighlightcolor},
			-activeforeground  => $config{colors}{activehighlightcolor},
			-command     => sub{$widget{safluo_thickness} -> configure(-state=>'normal');
					    map { $widget{$_}->configure(-foreground=>$blue) } (qw(safluo_thickness_lab safluo_thickness_lab2));
					    $widget{safluo_thickness}->configure(-foreground=>$black);
					    $widget{safluo_make} -> configure(-state=>'disabled');
					    my $str = 'k'.$plot_features{k_w};
					    $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
					    $last_plot='k';
					    $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
					    Echo($explain{booth});
					  },
			-value	     => 'booth',
			-variable    => \$safluo_params{algorithm})
    -> pack(-side=>'top', -anchor=>'w', -padx=>2, -pady=>2);
  $frame -> Radiobutton(-text	     => 'EXAFS (Troger)',
			-selectcolor => $config{colors}{single},
			-foreground  => $config{colors}{activehighlightcolor},
			-activeforeground  => $config{colors}{activehighlightcolor},
			-command     => sub{$widget{safluo_thickness} -> configure(-state=>'disabled');
					    map { $widget{$_}->configure(-foreground=>$grey) } (qw(safluo_thickness safluo_thickness_lab safluo_thickness_lab2));
					    $widget{safluo_make} -> configure(-state=>'disabled');
					    my $str = 'k'.$plot_features{k_w};
					    $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
					    $last_plot='k';
					    $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
					    Echo($explain{troger});
					  },
			-value	     => 'troger',
			-variable    => \$safluo_params{algorithm})
    -> pack(-side=>'top', -anchor=>'w', -padx=>2, -pady=>2);
  $frame -> Radiobutton(-text	     => 'EXAFS (Atoms)',
			-selectcolor => $config{colors}{single},
			-foreground  => $config{colors}{activehighlightcolor},
			-activeforeground  => $config{colors}{activehighlightcolor},
			-command     => sub{$widget{safluo_thickness} -> configure(-state=>'disabled');
					    map { $widget{$_}->configure(-foreground=>$grey) } (qw(safluo_thickness safluo_thickness_lab safluo_thickness_lab2));
					    $widget{safluo_make} -> configure(-state=>'disabled');
					    my $str = 'k'.$plot_features{k_w};
					    $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
					    $last_plot='k';
					    $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
					    Echo($explain{atoms});
					  },
			-value	     => 'atoms',
			-variable    => \$safluo_params{algorithm})
    -> pack(-side=>'top', -anchor=>'w', -padx=>2, -pady=>2);

  $frame = $top -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'right', -fill=>'x');
  $frame -> Label(-text=>"Group:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>0, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_group} = $frame -> Label(-anchor=>'w')
    -> grid(-row=>0, -column=>1, -columnspan=>4, -sticky=>'ew', -pady=>3);

  $frame -> Label(-text=>"Element:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>1, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_elem} = $frame -> Label(-width=>5, -anchor=>'w')
    -> grid(-row=>1, -column=>1, -sticky=>'w', -pady=>3);
  $frame -> Label(-text=>"      ",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>1, -column=>2, -sticky=>'e', -pady=>3);
  $frame -> Label(-text=>"Edge:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>1, -column=>3, -sticky=>'e', -pady=>3);
  $widget{safluo_edge} = $frame -> Label(-width=>3, -anchor=>'w')
    -> grid(-row=>1, -column=>4, -sticky=>'w', -pady=>3);

  $frame -> Label(-text=>"Formula:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>2, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_formula}= $frame -> Entry(-textvariable=>\$safluo_params{formula})
    -> grid(-row=>2, -column=>1, -columnspan=>4, -sticky=>'ew', -pady=>3);
  $widget{safluo_formula} -> bind("<KeyPress-Return>"=>sub{dispatch_sa(\%safluo_params)});

  $frame -> Label(-text=>"Angle in:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>3, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_angle_in} = $frame -> NumEntry(-width	      => 4,
						-orient	      => 'horizontal',
						-foreground   => $config{colors}{foreground},
						-textvariable => \$safluo_params{angle_in},
						-minvalue     => 0,
						-maxvalue     => 90,
					       )
    -> grid(-row=>3, -column=>1, -sticky=>'w', -pady=>3);
  $widget{safluo_angle_in} -> bind("<KeyPress-Return>"=>sub{dispatch_sa(\%safluo_params)});
  $frame -> Label(-text=>"Angle out:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>3, -column=>3, -sticky=>'e', -pady=>3);
  $widget{safluo_angle_out} = $frame -> NumEntry(-width	       => 4,
						 -orient       => 'horizontal',
						 -foreground   => $config{colors}{foreground},
						 -textvariable => \$safluo_params{angle_out},
						 -minvalue     => 0,
						 -maxvalue     => 90,
						)
    -> grid(-row=>3, -column=>4, -sticky=>'w', -pady=>3);
  $widget{safluo_angle_out} -> bind("<KeyPress-Return>"=>sub{dispatch_sa(\%safluo_params)});
  $widget{safluo_thickness_lab} = $frame -> Label(-text=>"Thickness:",
						  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>4, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_thickness} = $frame -> Entry(-width	       => 8,
					      -foreground      => $config{colors}{foreground},
					      -textvariable    => \$safluo_params{thickness},
					      -validate        => 'key',
					      -validatecommand => [\&set_variable, 'safluo_thickness']
					     )
    -> grid(-row=>4, -column=>1, -sticky=>'ew', -pady=>3);
  $widget{safluo_thickness} -> bind("<KeyPress-Return>"=>sub{dispatch_sa(\%safluo_params)});
  $widget{safluo_thickness_lab2} = $frame -> Label(-text       => "mic.",
						   -foreground => $config{colors}{activehighlightcolor},)
    -> grid(-row=>4, -column=>2, -sticky=>'w', -pady=>3);



  ## this is a spacer frame which pushes all the widgets to the top
  #$safluo -> Frame(-background=>$config{colors}{darkbackground})
  #  -> pack(-side=>'bottom', -expand=>1, -fill=>'both');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $safluo -> Button(-text=>'Return to the main window',  @button_list,
		    -background=>$config{colors}{background2},
		    -activebackground=>$config{colors}{activebackground2},
		    -command=>sub{## restore the main view
				  ##$groups{$current} -> dispose("erase s___a.resid s___a.postline s___a___nor\n", $dmode);
				  $groups{$current} -> dispose("erase s___a___nor\n", $dmode);
				  $groups{$current} -> dispose("erase \@group s___a\n", $dmode);
		                  &reset_window($safluo, "self absorption", \@save);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $safluo -> Button(-text=>'Document section: self absorption corrections', @button_list,
		    -command=>sub{pod_display("process::sa.pod") })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  ## now begin setting up the widgets you need for your new analysis
  ## feature

  ## now a new frame buttons
  $frame = $safluo -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -pady=>8);
  $widget{safluo_plot} = $frame -> Button(-text=>"Plot data and correction", @button_list,
					  -command=>sub{dispatch_sa(\%safluo_params)})
    -> pack(-fill=>'x');
  $frame -> Button(-text=>'Plot information depth', @button_list,
		    -command=>sub{dispatch_sa(\%safluo_params, 'info')})
    -> pack(-fill=>'x');
  $widget{safluo_make} = $frame -> Button(-text=>"Make corrected data group", @button_list,
					  -command=>sub{sa_group($current,\%safluo_params)})
    -> pack(-fill=>'x');


  $frame = $safluo -> LabFrame(-label=>'Feedback',
			       -foreground=>$config{colors}{activehighlightcolor},
			       -labelside=>'acrosstop')
    -> pack(-pady=>3, -padx=>3, -ipady=>3, -ipadx=>3, -fill=>'both', -expand=>1);
  $widget{safluo_feedback} = $frame -> Scrolled('ROText',
						-height	    => 1,
						-width	    => 1,
						-scrollbars => 'osoe',
						-wrap	    => 'none',
						-font	    => $config{fonts}{entry})
    -> pack(-fill=>'both', -padx=>2, -pady=>2, -expand=>1);
  $widget{safluo_feedback} -> Subwidget("xscrollbar") -> configure(-background=>$config{colors}{background});
  $widget{safluo_feedback} -> Subwidget("yscrollbar") -> configure(-background=>$config{colors}{background});
  $widget{safluo_feedback} -> tagConfigure('margin', -lmargin1=>4, -lmargin2=>4);
  $widget{safluo_feedback} -> tagConfigure('error', -lmargin1=>4, -lmargin2=>4, -foreground=>'red3');
  BindMouseWheel($widget{safluo_feedback});
  ## disable mouse-3
  my @swap_bindtags = $widget{safluo_feedback}->Subwidget('rotext')->bindtags;
  $widget{safluo_feedback} -> Subwidget('rotext') -> bindtags([@swap_bindtags[1,0,2,3]]);
  $widget{safluo_feedback} -> Subwidget('rotext') -> bind('<Button-3>' => sub{$_[0]->break});
  $widget{safluo_feedback} -> tagConfigure("text", -font=>$config{fonts}{fixedsm});


  ## disable thickness for Fluo, Troger, Atoms correction
  unless ($safluo_params{algorithm} eq 'booth') {
    $widget{safluo_thickness} -> configure(-state=>'disabled');
    ##map { print $_, "  ", ref $widget{$_}, $/ }
    foreach my $w ('safluo_thickness', 'safluo_thickness_lab', 'safluo_thickness_lab2') {
      #print $w, "  ", ref $widget{$w}, "  ", $config{colors}{disabledforeground}, $/;
      $widget{$w}->configure(-foreground=>$grey);
    };
  };

  ## insert group dependent data
  $widget{safluo_group} -> configure(-text=>$groups{$current}->{label});
  $widget{safluo_elem}  -> configure(-text=>$groups{$current}->{bkg_z});
  $widget{safluo_edge}  -> configure(-text=>$groups{$current}->{fft_edge});

  ## configure the buttons, insert the formula if it exists
  my $is_xmu = $groups{$current}->{is_xmu};
  $widget{safluo_plot} -> configure(-state=>($is_xmu) ? 'normal' : 'disabled');
  $widget{safluo_make} -> configure(-state=>'disabled');
  $widget{safluo_formula} -> focus;

  ## disable the Fluo button for chi data
  unless ($is_xmu) {
    ($safluo_params{algorithm} = "booth") if ($safluo_params{algorithm} eq 'fluo');
    $widget{safluo_fluo} -> configure(-state=>'disabled');
  };

  foreach my $k (qw(formula thickness angle_in angle_out)) {
    $safluo_params{$k} = $groups{$current}->{"sa_$k"} if (exists $groups{$current}->{"sa_$k"} and
							  $groups{$current}->{"sa_$k"} !~ /^\s*$/);
  };

  ## make a nice plot
  if ($safluo_params{algorithm} eq 'fluo') {
    $groups{$current}->plotE('emn', $dmode, \%plot_features, \@indicator) if $is_xmu;
    $last_plot = 'e';
    $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  } else {
    my $str = 'k'.$plot_features{k_w};
     $groups{$current}->plotk($str, $dmode, \%plot_features, \@indicator) if $is_xmu;
    $last_plot = 'k';
    $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  };

  $top -> update;

  ## and finally....
  #$top -> Unbusy;

};


sub dispatch_sa {
  my $rparams = $_[0];
  my $algorithm = $_[1] || 'correction';
  unless ($$rparams{formula}) {
    $widget{safluo_feedback} -> insert('end', "\nInput error:\n\tYou did not specify a chemical formula", ['error']);
    Error("You did not specify a chemical formula");
    return;
  };
  if ($$rparams{thickness} <= 0) {
    $widget{safluo_feedback} -> insert('end', "\nInput error:\n\tThe thickness must be a positive number", ['error']);
    Error("The thickness must be a positive number");
    return;
  };
 SWITCH: {
    sa_info_depth($rparams), last SWITCH if ($algorithm eq 'info');
    do_safluo($rparams),     last SWITCH if ($$rparams{algorithm} eq 'fluo');
    do_sabooth($rparams),    last SWITCH if ($$rparams{algorithm} eq 'booth');
    do_satroger($rparams),   last SWITCH if ($$rparams{algorithm} eq 'troger');
    do_saatoms($rparams),    last SWITCH if ($$rparams{algorithm} eq 'atoms');
  };
};


sub do_safluo {
  my $rparams = $_[0];
  Echo("Doing Fluo correction");
  $top -> Busy;

  my $e0shift = $groups{$current}->{bkg_eshift};
  my ($ok, $efluo, $rcount) = sa_feedback($rparams);
  unless ($ok) {
    Error("Error parsing formula.");
    $top -> Unbusy;
    return;
  };

  my $eplus = $groups{$current}->{bkg_e0} + $groups{$current}->{bkg_nor1} + $e0shift;
  my $enominal = Xray::Absorption -> get_energy($groups{$current}->{bkg_z}, $groups{$current}->{fft_edge});
  ($eplus = $enominal + 10) if ($eplus < $enominal);
  my ($barns_fluo, $barns_plus) = (0,0);
  my $mue_plus = 0;

  if ($ok) {
    foreach my $k (keys(%$rcount)) {

      ## compute contribution to mu_total at the fluo energy
      $barns_fluo += $$rcount{$k} * Xray::Absorption -> cross_section($k, $efluo);

      if (lc($k) eq lc(get_symbol($groups{$current}->{bkg_z}))) {
	## compute contribution to mu_abs at the above edge energy
	$mue_plus = $$rcount{$k} * Xray::Absorption -> cross_section($k, $eplus);
      } else {
	## compute contribution to mu_back at the above edge energy
	$barns_plus += $$rcount{$k} * Xray::Absorption -> cross_section($k, $eplus);
      };
    };
  };

  unless ($mue_plus > 0) {
    $widget{safluo_feedback} -> insert('end', "\nUnable to compute cross section of absorber above the edge", ['error']);
    $top -> Unbusy;
    return;
  };

  my $mut_fluo    = $barns_fluo;
  my $mub_plus    = $barns_plus;
  my $beta        = sprintf("%.6f", $mut_fluo/$mue_plus);
  my $gammaprime  = sprintf("%.6f", $mub_plus/$mue_plus);
  my $angle_ratio = sprintf("%.6f", sin(PI*$$rparams{angle_in}/180) / sin(PI*$$rparams{angle_out}/180));

  my @energy = Ifeffit::get_array($current.".energy");
  my @mub = ();
  foreach my $e (@energy) {
    my $barns = 0;
    foreach my $k (keys(%$rcount)) {
      next if (lc($k) eq lc(get_symbol($groups{$current}->{bkg_z})));
      $barns += Xray::Absorption -> cross_section($k, $e+$e0shift) * $$rcount{$k};
    };
    push @mub, $barns;
  };
  $groups{$current} -> dispose("## inserted s___a.mub into ifeffit's memory...", $dmode);
  Ifeffit::put_array("s___a.mub", \@mub);
  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  my $cmd = "## compute self absorption corrected data array using method of Haskel's Fluo\n";
  $cmd   .= "set(s___a.energy = $current.energy+$e0shift,\n";
  $cmd   .= "    s___a.num = $current.$suff * ($beta*$angle_ratio + s___a.mub/$mue_plus),\n";
  $cmd   .= "    s___a.den = ($beta*$angle_ratio + $gammaprime + 1) - $current.$suff,\n";
  $cmd   .= "    s___a.sacorr = s___a.num / s___a.den,\n";
  $cmd   .= "    ___x = max(ceil(s___a.sacorr), abs(floor(s___a.sacorr))) )";
  $groups{$current} -> dispose($cmd, $dmode);
  my $maxval = Ifeffit::get_scalar("___x");

  $groups{$current} -> plotE('emn', $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$current} -> dispose("plot(s___a.energy, s___a.sacorr, style=lines, color=\"$color\", key=\"SA corrected\")", $dmode);
  $last_plot='e';
  $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  if ($maxval > 30) {
    my $message = "
Yikes!

This correction seems to be numerically unstable.
Among the common reasons for this are:

  1. Providing the wrong chemical formula

  2. Having data from a sample that is not in the
     infinitely thick limit (the Fluo algorithm
     is not valid in the thin sample limit)

  3. Not including the matrix containing the sample
     in the formula for the stoichiometry (for
     instance, the formula for an aqueous solution
     must include the amount of H2O relative to the
     sample)

";
    $widget{safluo_feedback} -> insert('1.0', $message, ['error']);
  };

  $groups{$current} -> MAKE(sa_formula   => $$rparams{formula},
			    sa_thickness => $$rparams{thickness},
			    sa_angle_in  => $$rparams{angle_in},
			    sa_angle_out => $$rparams{angle_out},
			   );
  project_state(0);
  $widget{safluo_make} -> configure(-state=>'normal');

  Echo("Doing Fluo correction ... done!");
  $top -> Unbusy;
};


## all calculations done in microns!!
sub do_sabooth {
  my $rparams = $_[0];
  Echo("Doing Booth/Bridges correction");
  $top -> Busy;

  my $e0shift = $groups{$current}->{bkg_eshift};
  my ($ok, $efluo, $rcount) = sa_feedback($rparams);
  unless ($ok) {
    Error("Error parsing formula.");
    $top -> Unbusy;
    return;
  };


  my ($barns_fluo, $barns_plus) = (0,0);
  my $mue_plus = 0;

  my ($barns, $amu) = (0,0);
  foreach my $el (keys(%$rcount)) {
    $barns += Xray::Absorption -> cross_section($el, $efluo) * $$rcount{$el};
    $amu   += Xray::Absorption -> get_atomic_weight($el) * $$rcount{$el};
  };
  my $muf = sprintf("%.6f", $barns / $amu / 1.6607143);

  unless ($muf > 0) {
    $widget{safluo_feedback} -> delete('1.0', 'end');
    $widget{safluo_feedback} -> insert('end', "\nUnable to compute cross section of absorber at the fluorescence energy", ['error']);
    Error("Unable to compute cross section of absorber at the fluorescence energy");
    $top -> Unbusy;
    return;
  };

  $groups{$current} -> dispose("erase \@group s___a", $dmode);

  $groups{$current}->dispatch_bkg if $groups{$current}->{update_bkg};
  my @k = Ifeffit::get_array($current.".k");
  my @mut = ();
  my @mua = ();
  my $abs = ucfirst( lc(get_symbol($groups{$current}->{bkg_z})) );
  my $amuabs = Xray::Absorption -> get_atomic_weight($abs);
  foreach my $kk (@k) {
    my ($barns, $amu) = (0,0);
    my $e = $groups{$current}->k2e($kk) + $groups{$current}->{bkg_e0} + $e0shift;
    foreach my $el (keys(%$rcount)) {
      ##next if (lc($el) eq lc(get_symbol($groups{$current}->{bkg_z})));
      $barns += Xray::Absorption -> cross_section($el, $e) * $$rcount{$el};
      $amu   += Xray::Absorption -> get_atomic_weight($el) * $$rcount{$el};
    };
    ## 1 amu = 1.6607143 x 10^-24 gm
    push @mua, $$rcount{$abs} * Xray::Absorption -> cross_section($abs, $e) / $amu / 1.6607143;
    push @mut, $barns / $amu / 1.6607143;
  };
  $groups{$current} -> dispose("## inserted s___a.mut and s___a.mua into ifeffit's memory...", $dmode);
  $groups{$current} -> dispose("## compute self absorption corrected data array using method of Booth and Bridges", $dmode);
  Ifeffit::put_array("s___a.mut", \@mut);
  Ifeffit::put_array("s___a.mua", \@mua);

  my $dd = $$rparams{thickness} * 10e-4;

#   my $avg = 0;
#   map { $avg += $_ } @mua;
#   $avg /= ($#mua + 1);
#   $groups{$current} -> dispose("set ___x = ceil($current.chi)", 1);
#   my $chimax = Ifeffit::get_scalar("___x");


  my $angle_ratio = sprintf("%.6f", sin(PI*$$rparams{angle_in}/180) / sin(PI*$$rparams{angle_out}/180));
  my $precmd = "set(s___a.alpha   = s___a.mut + $angle_ratio*$muf,\n";
  $precmd   .= "    s___a.exparg  = $dd*s___a.alpha/sin(pi*$$rparams{angle_in}/180),\n";
  $precmd   .= "    s___a.beta    = s___a.mua * exp(-1 * s___a.exparg) * s___a.exparg,\n";
  $precmd   .= "    s___a.gamma   = 1 - exp(-1 * s___a.exparg),\n";
  $precmd   .= "    s___a.term1   = s___a.gamma*(s___a.alpha - s___a.mua*($current.chi+1)) + s___a.beta,\n";
  $precmd   .= "    s___a.term2   = 4*s___a.alpha*s___a.beta*s___a.gamma*$current.chi,\n";
  $precmd   .= "    s___a.sqrtarg = s___a.term1**2 + s___a.term2)\n";


  $groups{$current} -> dispose($precmd, $dmode);
  $groups{$current} -> dispose("set(___x = floor(s___a.beta), ___xx = floor(s___a.sqrtarg))", 1);
  my $betamin = Ifeffit::get_scalar("___x");
  my $isneg = Ifeffit::get_scalar("___xx");
  my $thickcheck = ($betamin < 10e-7) || ($isneg < 0);
  my $message;

  my $cmd = "";
  if ($thickcheck > 0.005) {
    $widget{safluo_feedback} -> insert('end', "\nYou are in the thick sample limit.\nUsing the thick limit approximation.\n", ['margin']);
    $cmd .= "## thick limit\n";
    $cmd .= "set(s___a.s     = s___a.mua/s___a.alpha,\n";
    $cmd .= "    s___a.denom = (1 - s___a.s*($current.chi + 1)),\n";
    $cmd .= "    s___a.chi   = $current.chi / s___a.denom)\n";
    $message = "(thick sample limit)";
  } else {
    $widget{safluo_feedback} -> insert('end', "\nYou are in the thin sample regime.\nUsing the nearly exact expression.\n", ['margin']);
    $cmd .= "## thin regime\n";
    $cmd .= "set(s___a.chi    = (-1 * s___a.term1 + sqrt(s___a.sqrtarg)) / (2*s___a.beta))\n";
    $message = "(thin sample regime)";
  };

  $groups{$current} -> dispose($cmd, $dmode);

  my $str = 'k'.$plot_features{k_w};
  $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$current} -> dispose("plot($current.k, \"s___a.chi*$current.k**$plot_features{k_w}\", style=lines, color=\"$color\", key=\"SA corrected\")", $dmode);
  $last_plot='k';
  $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);

  $groups{$current} -> MAKE(formula=>$$rparams{formula});
  project_state(0);
  $widget{safluo_make} -> configure(-state=>'normal');

  Echo("Doing Booth/Bridges correction $message ... done!");
  $top -> Unbusy;
};


sub do_satroger {
  my $rparams = $_[0];
  Echo("Doing Troger et al. correction");
  $top -> Busy;

  my $e0shift = $groups{$current}->{bkg_eshift};
  my ($ok, $efluo, $rcount) = sa_feedback($rparams);
  unless ($ok) {
    Error("Error parsing formula.");
    $top -> Unbusy;
    return;
  };

  my ($barns, $amu) = (0,0);
  foreach my $el (keys(%$rcount)) {
    $barns += Xray::Absorption -> cross_section($el, $efluo) * $$rcount{$el};
    $amu   += Xray::Absorption -> get_atomic_weight($el) * $$rcount{$el};
  };
  my $muf = sprintf("%.6f", $barns / $amu / 1.6607143);
  my $angle_ratio = sprintf("%.6f", sin(PI*$$rparams{angle_in}/180) / sin(PI*$$rparams{angle_out}/180));

  my @k = Ifeffit::get_array($current.".k");
  my @mut = ();
  my @mua = ();
  my $abs = ucfirst( lc(get_symbol($groups{$current}->{bkg_z})) );
  foreach my $kk (@k) {
    my $barns = 0;
    my $e = $groups{$current}->k2e($kk) + $groups{$current}->{bkg_e0} + $e0shift;
    foreach my $el (keys(%$rcount)) {
      $barns += Xray::Absorption -> cross_section($el, $e) * $$rcount{$el};
    };
    ## 1 amu = 1.6607143 x 10^-24 gm
    push @mut, $barns / $amu / 1.6607143;
    push @mua, $$rcount{$abs} * Xray::Absorption -> cross_section($abs, $e) / $amu / 1.6607143;
  };
  $groups{$current} -> dispose("## compute self absorption corrected data array using method of Troger et al", $dmode);
  $groups{$current} -> dispose("## inserted s___a.mut and s___a.mua into ifeffit's memory...", $dmode);
  Ifeffit::put_array("s___a.mut", \@mut);
  Ifeffit::put_array("s___a.mua", \@mua);

  my $sets = "set(s___a.alpha = s___a.mut + $angle_ratio*$muf,";
  $sets   .= "    s___a.s     = s___a.mua / s___a.alpha,";
  $sets   .= "    s___a.chi   = $current.chi / (1 - s___a.s) )";
  $groups{$current} -> dispose($sets, $dmode);

  my $str = 'k'.$plot_features{k_w};
  $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$current} -> dispose("plot($current.k, \"s___a.chi*$current.k**$plot_features{k_w}\", style=lines, color=\"$color\", key=\"SA corrected\")", $dmode);
  $last_plot='k';
  $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);

  $groups{$current} -> MAKE(formula=>$$rparams{formula});
  project_state(0);
  $widget{safluo_make} -> configure(-state=>'normal');

  Echo("Doing Troger correction ... done!");
  $top -> Unbusy;
};



sub do_saatoms {
  my $rparams = $_[0];
  Echo("Doing Atoms correction");
  $top -> Busy;

  my $e0shift = $groups{$current}->{bkg_eshift};
  my ($ok, $efluo, $rcount) = sa_feedback($rparams);
  unless ($ok) {
    Error("Error parsing formula.");
    $top -> Unbusy;
    return;
  };

  my $mm_sigsqr = Xray::FluorescenceEXAFS->mcmaster($groups{$current}->{bkg_z},
						    $groups{$current}->{fft_edge});
  my $i0_sigsqr = Xray::FluorescenceEXAFS->i_zero($groups{$current}->{bkg_z},
						  $groups{$current}->{fft_edge},
						  {nitrogen=>1,argon=>0,krypton=>0});
  my ($self_amp, $self_sigsqr) = Xray::FluorescenceEXAFS->self($groups{$current}->{bkg_z},
							       $groups{$current}->{fft_edge},
							       $rcount);
  my $net = sprintf("%.6f", $self_sigsqr+$i0_sigsqr+$i0_sigsqr);

  my $answer .= sprintf("\nSelf amplitude : %6.3f\n",   $self_amp);
  $answer    .= sprintf("Self           : %8.5f A^2\n", $self_sigsqr);
  $answer    .= sprintf("Normalization  : %8.5f A^2\n", $mm_sigsqr);
  $answer    .= sprintf("I0             : %8.5f A^2\n", $i0_sigsqr);
  $answer    .= sprintf("   net sigma^2 : %8.5f A^2\n", $net);
  $widget{safluo_feedback} -> insert('end', $answer, ['margin']);

  $groups{$current} -> dispose("set(s___a.chi = $self_amp * $current.chi * exp($net*$current.k^2))", $dmode);
  my $str = 'k'.$plot_features{k_w};
  $groups{$current} -> plotk($str, $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$current} -> dispose("plot($current.k, \"s___a.chi*$current.k**$plot_features{k_w}\", style=lines, color=\"$color\", key=\"SA corrected\")", $dmode);
  $last_plot='k';
  $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);

  $groups{$current} -> MAKE(formula=>$$rparams{formula});
  project_state(0);
  $widget{safluo_make} -> configure(-state=>'normal');

  Echo("Doing Atoms correction ... done!");
  $top -> Unbusy;
};




sub sa_group {
  my ($parent, $rparams) = @_;
  my ($group, $label) = ("SA ".$groups{$parent}->{label}, "");
  ($group, $label) = group_name($group);
  $label = "SA ".$groups{$parent}->{label};
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  ## copy the titles
  my $line = Xray::Absorption->get_Siegbahn_full($$rparams{line});
  my $method = "";
 SWITCH: {
    $method = "Haskel's Fluo",     last SWITCH if ($$rparams{algorithm} eq 'fluo');
    $method = "Booth and Bridges", last SWITCH if ($$rparams{algorithm} eq 'booth');
    $method = "Troger et al.",     last SWITCH if ($$rparams{algorithm} eq 'troger');
    $method = "correction terms from Atoms", last SWITCH if ($$rparams{algorithm} eq 'atoms');
  };
  push @{$groups{$group}->{titles}},
    "Self absorption correction of \"$groups{$parent}->{label}\" using method of $method";
  if ($$rparams{algorithm} eq 'booth') {
    push @{$groups{$group}->{titles}},
      "+  $groups{$parent}->{bkg_z} $groups{$parent}->{fft_edge} edge, computed using the $groups{$parent}->{bkg_z} $line line",
	"+  Formula=$$rparams{formula}, Thickness=$$rparams{thickness} microns",
	  "+  Incident angle=$$rparams{angle_in} degrees, Outgoing angle=$$rparams{angle_out} degrees";
  } else {
    push @{$groups{$group}->{titles}},
      "+  $groups{$parent}->{bkg_z} $groups{$parent}->{fft_edge} edge, computed using the $groups{$parent}->{bkg_z} $line line",
	"+  Formula=$$rparams{formula}, Incident/Outgoing angles: [$$rparams{angle_in}, $$rparams{angle_out}] degrees";
  };
  $groups{$group} -> make(file=>"Self absorption correction of \"$groups{$parent}->{label}\"");
  foreach (@{$groups{$parent}->{titles}}) {
    push   @{$groups{$group}->{titles}}, $_;
  };
  $groups{$group} -> put_titles;
  $groups{$group} -> set_to_another($groups{$parent});
  $groups{$group} -> make(is_rsp => 0, is_qsp => 0, is_bkg => 0, not_data => 0, bkg_eshift=>0);
  if ($$rparams{algorithm} eq 'fluo') {
    ## xanes correction
    $groups{$group} -> make(is_xmu => 1, is_chi => 0);
    $groups{$group} -> dispose("set($group.energy = s___a.energy, $group.xmu = s___a.sacorr)", $dmode);
  } else {
    ## exafs correction
    $groups{$group} -> make(is_xmu => 0, is_chi => 1);
    $groups{$group} -> dispose("set($group.k = $parent.k, $group.chi = s___a.chi)", $dmode);
  };
  ++$line_count;
  fill_skinny($list, $group, 1, 1);
  Echo("Saved absorption corrected data group.");
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};




## do some chores common to all algorithms
sub sa_feedback {
  my $rparams = $_[0];

  $widget{safluo_feedback} -> delete('1.0', 'end');
 SWITCH: {
    $$rparams{line} = 'Ka1', last SWITCH if (lc($groups{$current}->{fft_edge}) eq 'k');
    $$rparams{line} = 'La1', last SWITCH if (lc($groups{$current}->{fft_edge}) eq 'l3');
    $$rparams{line} = 'Lb1', last SWITCH if (lc($groups{$current}->{fft_edge}) eq 'l2');
    $$rparams{line} = 'Lb3', last SWITCH if (lc($groups{$current}->{fft_edge}) eq 'l1');
    $$rparams{line} = 'Ma',  last SWITCH if (lc($groups{$current}->{fft_edge}) =~ /^m/);
  };
  my $efluo = Xray::Absorption -> get_energy($groups{$current}->{bkg_z}, $$rparams{line});

  my %count;
  my $ok = parse_formula($$rparams{formula}, \%count);
  my $answer = "\nEdge energy = " . $groups{$current}->{bkg_e0} . $/;
  $answer   .= sprintf("The dominant fluorescence line is %s (%s)\n",
		       Xray::Absorption -> get_Siegbahn_full($$rparams{line}),
		       Xray::Absorption -> get_IUPAC($$rparams{line}));
  $answer   .= sprintf("Fluorescence energy = %.2f\n", $efluo);
  if ($ok) {
    $answer .= "\n  element   number \n";
    $answer .= " --------- ----------------\n";
    foreach my $k (sort (keys(%count))) {
      if ($count{$k} > 0.001) {
	$answer  .= sprintf("    %-2s %11.3f\n", $k, $count{$k});
      } else {
	$answer  .= sprintf("    %-2s      %g\n", $k, $count{$k});
      };
    };
    $widget{safluo_feedback} -> insert('end', $answer, ['margin']);
  } else {
    $widget{safluo_feedback} -> insert('end', "\nInput error:\n\t".$count{error}, ['error']);
    return
  };

  return ($ok, $efluo, \%count);
};

sub sa_info_depth {
  my $rparams = $_[0];
  Echo("Computing information depth");
  $top -> Busy;

  my $e0shift = $groups{$current}->{bkg_eshift};
  my ($ok, $efluo, $rcount) = sa_feedback($rparams);
  unless ($ok) {
    Error("Error parsing formula.");
    $top -> Unbusy;
    return;
  };

  my ($barns, $amu) = (0,0);
  foreach my $el (keys(%$rcount)) {
    $barns += Xray::Absorption -> cross_section($el, $efluo) * $$rcount{$el};
    $amu   += Xray::Absorption -> get_atomic_weight($el) * $$rcount{$el};
  };
  my $muf = sprintf("%.6f", $barns / $amu / 1.6607143);
  my $angle_ratio = sprintf("%.6f", sin(PI*$$rparams{angle_in}/180) / sin(PI*$$rparams{angle_out}/180));

  my @k = Ifeffit::get_array($current.".k");
  my $kmax = ($k[$#k] > $plot_features{kmax}) ? $plot_features{kmax} : $k[$#k];
  my @mut = ();
  foreach my $kk (@k) {
    my ($barns, $amu) = (0,0);
    my $e = $groups{$current}->k2e($kk) + $groups{$current}->{bkg_e0} + $e0shift;
    foreach my $el (keys(%$rcount)) {
      ##next if (lc($el) eq lc(get_symbol($groups{$current}->{bkg_z})));
      $barns += Xray::Absorption -> cross_section($el, $e) * $$rcount{$el};
      $amu   += Xray::Absorption -> get_atomic_weight($el) * $$rcount{$el};
    };
    ## 1 amu = 1.6607143 x 10^-24 gm
    push @mut, $barns / $amu / 1.6607143;
  };

  $groups{$current} -> dispose("## inserted s___a.mut into ifeffit's memory...", $dmode);
  Ifeffit::put_array("s___a.mut", \@mut);
  my $sets = "set(s___a.alpha = s___a.mut + $angle_ratio*$muf,";
  $sets   .= "    s___a.info = 10000*sin(pi*$$rparams{angle_in}/180) / s___a.alpha)";
  $groups{$current} -> dispose($sets, $dmode);
  my $command = "($current.k, s___a.info, xmin=$plot_features{kmin}, xmax=$kmax, ";
  $command   .= "xlabel=k (\\A\\u-1\\d), ylabel=\"Depth (\\gmm)\", ";
  my $screen = "fg=$config{plot}{fg}, bg=$config{plot}{bg}, ";
  $screen .= ($config{plot}{grid} eq $config{plot}{bg}) ? "nogrid, " :
    "grid, gridcolor=$config{plot}{grid}, ";
  $command   .= $screen;
  $command   .= "style=lines, color=blue, key=\"\\gl(k)\", title=\"Information Depth\")";
  $command    = wrap("newplot", "       ", $command) . $/;
  $groups{$current} -> dispose($command, $dmode);
  $top -> Unbusy;
  Echo("Computing information depth ... done!");
};


## END OF SELF-ABSORPTION SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2010 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  multi-electron excitation removal

sub mee {
  Echo("No data!"), return unless $current;

  my $key = join("_", lc($groups{$current}->{bkg_z}), lc($groups{$current}->{fft_edge}));
  my %mee_params = (
		    shift  => $groups{$current}->{mee_en} || $mee_energies{energies}{$key} || $config{mee}{shift},
		    width  => $groups{$current}->{mee_wi} || $config{mee}{width},
		    amp    => $groups{$current}->{mee_am} || $config{mee}{amp},
		    key    => $key,
		    choice => $groups{$current}->{mee_choice} || $config{mee}{choice}  || 'Edge',
		   );
  my $color = $plot_features{c1};
  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = -200; #$config{mee}{emin};
  $plot_features{emax} = 1100; #$config{mee}{emax};
  project_state($ps);		# don't toggle if currently saved

  Echo("No data!"), return if ($current eq "Default Parameters");

  my @label = (-font=>$config{fonts}{small}, -foreground=>'black', );

  $fat_showing = 'mee';
  $hash_pointer = \%mee_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $mee = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  $which_showing = $mee;

  $mee -> Label(-text=>"Multi-electron excitation removal",
		-font=>$config{fonts}{large},
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## select the alignment standard
  my $frame = $mee -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -pady=>8);
  $frame -> Label(-text=>"Data: ", @label,)
    -> grid(-row=>0, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{mee_data} = $frame -> Label(-text=>$groups{$current}->{label},
				      -foreground=>$config{colors}{button})
    -> grid(-row=>0, -column=>1, -columnspan=>3, -sticky=>'w', -pady=>2, -padx=>2);

  my $t = $frame -> Label(-text=>"Functional form: ", @label,)
    -> grid(-row=>1, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{mee_choice} = $frame -> Optionmenu(-textvariable => \$mee_params{choice},
					     -options      => ['Edge', 'Arctangent'],
					     -borderwidth  => 1,
					     -width=>10, -justify=>'right')
    -> grid(-row=>1, -column=>1, -sticky=>'w');


  $t = $frame -> Label(-text=>"Energy offset: ", @label,)
    -> grid(-row=>2, -column=>0, -sticky=>'e', -ipady=>2);
  &click_help($t,"mee_en");
  $widget{mee_en} = $frame -> RetEntry(-textvariable=>\$mee_params{shift},
				       -validate=>'key',
				       -command=>sub{ mee_plot($config{mee}{plot}, \%mee_params)},
				       -validatecommand=>[\&set_variable, 'mee_en'],
				       -width=>8)
    -> grid(-row=>2, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);
  $frame -> Label(-text=>" eV", @label,)
    -> grid(-row=>2, -column=>2, -sticky=>'w', -ipady=>2);

  $t = $frame -> Label(-text=>"Broadening: ", @label,)
    -> grid(-row=>3, -column=>0, -sticky=>'e', -ipady=>2);
  &click_help($t,"mee_wi");
  $widget{mee_wi} = $frame -> RetEntry(-textvariable=>\$mee_params{width},
				       -validate=>'key',
				       -command=>sub{ mee_plot($config{mee}{plot}, \%mee_params)},
				       -validatecommand=>[\&set_variable, 'mee_wi'],
				       -width=>8)
    -> grid(-row=>3, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);
  $frame -> Label(-text=>" eV", @label,)
    -> grid(-row=>3, -column=>2, -sticky=>'w', -ipady=>2);

  $t = $frame -> Label(-text=>"Amplitude: ", @label,)
    -> grid(-row=>4, -column=>0, -sticky=>'e', -ipady=>2);
  &click_help($t,"mee_am");
  $widget{mee_am} = $frame -> RetEntry(-textvariable=>\$mee_params{amp},
				       -validate=>'key',
				       -command=>sub{ mee_plot($config{mee}{plot}, \%mee_params)},
				       -validatecommand=>[\&set_variable, 'mee_am'],
				       -width=>8)
    -> grid(-row=>4, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);

  $frame = $mee -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -pady=>8, -fill=>'x');
  $frame -> Label(-text=>"Plot data and correction in:",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> pack(-side=>'top', -fill=>'x', -pady=>2);
  my $fr = $frame -> Frame()
    -> pack(-side=>'top', -pady=>2, -fill=>'x', -expand=>1);
  $widget{mee_e} = $fr -> Button(-text    => 'E', @button_list,
				 -command => sub{mee_plot('e', \%mee_params)})
    -> pack(-side=>'left', -padx=>2, -fill=>'x', -expand=>1);
  $widget{mee_k} = $fr -> Button(-text    => 'k', @button_list,
				 -command => sub{mee_plot('k', \%mee_params)})
    -> pack(-side=>'left', -padx=>2, -fill=>'x', -expand=>1);
  $widget{mee_r} = $fr -> Button(-text    => 'R', @button_list,
				 -command => sub{mee_plot('r', \%mee_params)})
    -> pack(-side=>'left', -padx=>2, -fill=>'x', -expand=>1);
  $widget{mee_q} = $fr -> Button(-text    => 'q', @button_list,
				 -command => sub{mee_plot('q', \%mee_params)})
    -> pack(-side=>'left', -padx=>2, -fill=>'x', -expand=>1);
  $widget{mee_make} = $mee
    -> Button(-text=>"Make corrected data group", @button_list,
	      -command=>sub{mee_group(\%mee_params)})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');
  $widget{mee_store} = $mee
    -> Button(-text=>"Store this MEE offset energy", @button_list,
	      -command=>
	      sub {
		$mee_energies{energies}{$mee_params{key}} = $mee_params{shift};
		my $tenergies = tied %mee_energies;
		$tenergies -> WriteConfig($groups{"Default Parameters"} -> find('athena', 'mee'));
		my $message = sprintf("Stored %s as the energy shift for the %s %s edge.",
				      $mee_params{shift},
				      ucfirst($groups{$current}->{bkg_z}),
				      ucfirst($groups{$current}->{fft_edge}));
		Echo($message);
	      })
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w', -pady=>4);

  $mee -> Button(-text=>'Return to the main window',  @button_list,
		 -background=>$config{colors}{background2},
		 -activebackground=>$config{colors}{activebackground2},
		 -command=>sub{
		   &reset_window($mee, "multi-electron removal", \@save);
		 })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $mee -> Button(-text=>'Document section: multi-electron excitation removal', @button_list,
		 -command=>sub{pod_display("process::mee.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  if (not $groups{$current}->{is_xmu}) {
    map {$widget{"mee_$_"}  -> configure(-state=>'disabled')} qw(store make e k r q);
  };
  $top -> update;
};


sub mee_correct {
  my ($rmp, $plot) = @_;;

  ($groups{$current}->{update_bkg}) and $groups{$current}->dispatch_bkg($dmode);

# A*[atan((e-E0)/W)/pi + 0.5]

  my $commands = q{};
  if ($$rmp{choice} eq 'Edge') {
    $commands .= "##\n## performing multi-electron excitation removal using a reflection of the Edge\n";
    $commands .= "set(m___ee.nn     = lconvolve($current.energy, $current.norm, $$rmp{width}),\n";
    $commands .= "    m___ee.energy = $current.energy,\n";
    $commands .= "    m___ee.ee     = m___ee.energy +  $$rmp{shift},\n";
    $commands .= "    m___ee.xint   = interp(m___ee.ee, m___ee.nn, $current.energy))\n";
    $commands .= "## use perl to pad zeros at the beginning of the shifted array\n";
    $groups{$current} -> dispose($commands, $dmode);

    my @x  = Ifeffit::get_array("$current.energy");
    my $e1 = $x[0] + $$rmp{shift};
    my @y  = Ifeffit::get_array("m___ee.xint");
    my $yoff = 0;
    my $edgestep = $groups{$current}->{bkg_step};
    foreach my $i (0 .. $#x) {
      if ($x[$i] < $e1) {
	## this replaces the extrapolated part of the shifted spectrum
	## with zeros in the pre-edge
	$yoff = $y[$i];
	$y[$i] = 0;
      } else {
	## this corrects for the pre-edge not going to the baseline
	## after the convolution and approximately corrects the edge
	## step of the convoluted mu(E) data
	## $y[$i] = ($y[$i] - $yoff);# * (1 + $yoff);
      };
    };
    Ifeffit::put_array("m___ee.xint", \@y);
  } else {
    my $e0 = $groups{$current}->{bkg_e0}+$$rmp{shift};
    $commands .= "##\n## performing multi-electron excitation removal using an arctangent\n";
    $commands .= "set(m___ee.energy = $current.energy,\n";
    $commands .= "    m___ee.xint   = atan((m___ee.energy-$e0)/$$rmp{width})/pi + 0.5 )\n";

  };

  $commands .= "set(m___ee.xmu = $current.norm - $$rmp{amp}*m___ee.xint)\n";
  $groups{$current} -> dispose($commands, $dmode);

  mee_plot($config{mee}{plot}, $rmp) if $plot;


  #$groups{$current} -> plotE('em',$dmode,\%plot_features, \@indicator);
  #$groups{$current} -> dispose("plot($current.energy, m___ee.corr)");

};

sub mee_plot {
  my ($space, $rmp) = @_;
  Echonow("Correcting multi-electron excitation in \"$groups{$current}->{label}\" ...");
  $top->Busy;
  my $mode = $dmode;
  ($mode & 2) or ($mode += 2);
  @ifeffit_buffer = ();
  mee_correct($rmp, 0);
  my $save = $groups{$current}->{bkg_flatten};
  $groups{$current} -> make(update_bkg=>1, bkg_flatten=>0);
  my $command = q{};
  SWITCH: {
    ($space eq 'e') and do {
      $groups{$current} -> plotE('emn',$mode,\%plot_features, \@indicator);
      last SWITCH;
    };
    ($space eq 'k') and do {
      $groups{$current} -> plotk('k',$mode,\%plot_features, \@indicator);
      last SWITCH;
    };
    ($space eq 'r') and do {
      my $str = $plot_features{r_marked};
      $groups{$current} -> plotR($str,$mode,\%plot_features, \@indicator);
      last SWITCH;
    };
    ($space eq 'q') and do {
      my $str = $plot_features{q_marked};
      $groups{$current} -> plotq($str,$mode,\%plot_features, \@indicator);
      last SWITCH;
    };
  };
  foreach my $line (@ifeffit_buffer) {
    ($command .= $line) =~ s{$current\.}{m___ee.}g;
  };
  $command =~ s{newplot}{plot}g;
  $command =~ s{\.norm}{.xmu}g;
  $command =~ s{pre1=}{find_e0=F, pre1=}g;
  $command =~ s{$config{plot}{c0}}{$config{plot}{c1}}g;
  @ifeffit_buffer = ();
  ## print $command;
  $groups{$current} -> dispose($command, $dmode);
  $groups{$current} -> make(bkg_flatten=>$save);
  Echonow("Correcting multi-electron excitation in \"$groups{$current}->{label}\" ... done!");
  $top->Unbusy;
};



## make a new data group out of the mee-corrected data, make this an
## xmu group so it can be treated like normal data
sub mee_group {
  my $rhash = $_[0];
  $top->Busy;
  mee_correct($rhash, 0);
  my $group = $groups{$current}->{group};
  my ($new, $label) = group_name("MEE $group");
  $label = "MEE " . $groups{$current}->{label} . ": e " . $$rhash{shift} . " a " . $$rhash{amp};
  $groups{$new} = Ifeffit::Group -> new(group=>$new, label=>$label);
  $groups{$new} -> set_to_another($groups{$group});
  $groups{$new} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0,
			is_qsp => 0, is_bkg => 0, is_nor => 1,
			not_data => 0);
  $groups{$new} -> make(bkg_e0 => $groups{$group}->{bkg_e0});
  $groups{$new} -> make(file => "MEE correction using $$rhash{choice} of $groups{$current}->{label} at $$rhash{shift} eV");
  $groups{$new}->{titles} = [];
  push @{$groups{$new}->{titles}},
    "MEE correction using $$rhash{choice} of $groups{$current}->{label}: shift=$$rhash{shift} eV",
      "broadening=$$rhash{width}, amplitude=$$rhash{amp}";
  $groups{$new} -> put_titles;
  $groups{$new} -> dispose("set($new.energy = $group.energy, $new.xmu = m___ee.xmu)", $dmode);
  ++$line_count;
  $reading_project = 1;		# sloppy ... see main_window.pl
  fill_skinny($list, $new, 1, 1);
  $reading_project = 0;
  project_state(0);
  my $memory_ok = $groups{$new}
    -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo("WARNING: Ifeffit is out of memory!"), return if ($memory_ok == -1);
  Echo("Saved MEE correction of \"$groups{$current}->{label}\" as a new data group");
  $top->Unbusy;
};
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  difference spectra

sub difference {
  Echo("No data!"), return unless $current;
  my $space = $_[0];
  #$space = ($space eq 'x') ? 'em' : 'em'.$space;
  my %sp = (e=>'energy', n=>'energy', k=>'k', r=>'R', 'q'=>'q');

  Echo("No data!"), return if ($current eq "Default Parameters");

  ## make the list of groups that can be difference-d in the requested space
  my @allkeys = &sorted_group_list;
  my @keys = ();
  my $header = "";
  my $ysuff;
 SWITCH: {
    ($space eq 'e') and do {
      foreach my $k (@allkeys) {
	($groups{$k}->{is_xmu}) and push @keys, $k;
      };
      $header = "Compute the Difference of mu(E) Spectra";
      $ysuff  = 'xmu';
      last SWITCH;
    };
    ($space eq 'n') and do {
      foreach my $k (@allkeys) {
	(($groups{$k}->{is_xmu}) or ($groups{$k}->{is_nor})) and push @keys, $k;
      };
      $header = "Compute the Difference of Normalized Spectra";
      $ysuff  = $groups{$keys[0]}->{bkg_flatten} ? 'flat' : 'norm';
      last SWITCH;
    };
    ($space eq 'k') and do {
      foreach my $k (@allkeys) {
	(($groups{$k}->{is_xmu}) or ($groups{$k}->{is_nor}) or ($groups{$k}->{is_chi}))
	  and push @keys, $k;
      };
      $header = "Compute the Difference of chi(k)";
      $ysuff  = 'chi';
      last SWITCH;
    };
    ($space eq 'r') and do {
      foreach my $k (@allkeys) {
	($groups{$k}->{is_qsp}) or push @keys, $k;
      };
      $header = "Compute the Difference of chi(R)";
      if    ($plot_features{r_mag}) {$ysuff = "chir_mag"}
      elsif ($plot_features{r_re})  {$ysuff = "chir_re"}
      elsif ($plot_features{r_im})  {$ysuff = "chir_im"}
      elsif ($plot_features{r_pha}) {$ysuff = "chir_pha"};
      last SWITCH;
    };
    1 and do {			# difference in q, any'll do
      foreach my $k (@allkeys) {
	($groups{$k}->{not_data}) or push @keys, $k;
      };
      $header = "Compute the Difference of chi(q)";
      if    ($plot_features{'q_mag'}) {$ysuff = 'chiq_mag'}
      elsif ($plot_features{'q_re'})  {$ysuff = "chiq_re"}
      elsif ($plot_features{'q_im'})  {$ysuff = "chiq_im"}
      elsif ($plot_features{'q_pha'}) {$ysuff = "chiq_pha"};
      last SWITCH;
    };
  };
  Echo("You need two or more groups that can display in $sp{$space} to compute that difference spectrum"),
    return unless ($#keys >= 1);


  my %diff_params = (standard	    => $keys[0],
		     standard_label => "1: ".$groups{$keys[0]}->{label},
		     keys           => \@keys,
		     space	    => $space,
		     xnot           => 0,
		     xsuff          => $sp{$space},
		     ysuff          => $ysuff,
		     xmin           => 0,
		     xmax           => 0,
		     invert         => 0,
		     components     => 0,
		     list           => $list,
		     groups         => \%groups,
		     noplot         => 0,
    ## The options are
    ##    e, n, d            mu, normalized mu, or deriv of mu
    ##    kw, 0, 1, 2, 3, e  chi(k) with k-weight or chi(E) with k-weight
    ##    rm, rp, rr, ri     chi(R), magnitude, phase, real, imaginary
    ##    qm, qp, qr, qi     chi(q), magnitude, phase, real, imaginary
		    );
  if ($space =~ /[en]/) {
    $diff_params{xnot} = $groups{$keys[0]}->{bkg_e0};
    $diff_params{xmin} = $config{diff}{emin};
    $diff_params{xmax} = $config{diff}{emax};
  } elsif ($space =~ /[kq]/) {
    $diff_params{xmin} = $config{diff}{kmin};
    $diff_params{xmax} = $config{diff}{kmax};
  } else {
    $diff_params{xmin} = $config{diff}{rmin};
    $diff_params{xmax} = $config{diff}{rmax};
  };


  if ($diff_params{standard} eq $current) { # make sure $current is sensible given
    set_properties(1, $keys[1], 0);            # that $keys[0] is the standard
    # adjust the view
    my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
    ($here < 0) and ($here = 0);
    my $full = ($list->bbox(@skinny_list))[3] + 5;
    $list -> yview('moveto', $here/$full);
  };

  $fat_showing = 'diff';
  $hash_pointer = \%diff_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $diff = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$diff -> packPropagate(0);
  $which_showing = $diff;

  $diff -> Label(-text=>$header,
		 -font=>$config{fonts}{large},
		 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## select the difference standard
  my $frame = $diff -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x');
  $frame -> Label(-text=>"Standard: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
	    -> grid(-row=>0, -column=>0);


  $widget{diff_menu} = $frame -> BrowseEntry(-variable => \$diff_params{standard_label},
					     @browseentry_list,
					     -browsecmd => sub {
					       my $text = $_[1];
					       my $this = $1 if ($text =~ /^(\d+):/);
					       Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless $this;
					       $this -= 1;
					       Error("Difference group aborted: You selected the same data group twice!"),
						 return if ($diff_params{keys}->[$this] eq $current);
					       $diff_params{standard}=$diff_params{keys}->[$this];
					       ##$diff_params{standard_label} = $groups{$diff_params{standard}}->{label};
					       ($diff_params{xnot} = $groups{$diff_params{standard}}->{bkg_e0})
						 if ($diff_params{space} =~ /[en]/);
					       $groups{$diff_params{standard}} ->
						 plot_difference($groups{$current}, \%diff_params, $dmode, \%plot_features);
					       $last_plot=$space;
					     })
    -> grid(-row=>0, -column=>1);
  my $i = 1;
  foreach my $s (@keys) {
    $widget{diff_menu} -> insert("end", "$i: $groups{$s}->{label}");
    ++$i;
  };


  ## select the other group
  $frame -> Label(-text=>"Other: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>1, -column=>0);
  $widget{diff_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					  -foreground=>$config{colors}{button})
    -> grid(-row=>1, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);

  $frame -> Checkbutton(-text	     => 'Invert difference spectra',
			-selectcolor => $config{colors}{single},
			-variable    => \$diff_params{invert},
			-command     => sub{$widget{diff_replot}->invoke},
		       )
    -> grid(-row=>2, -column=>0, -columnspan=>2, -sticky=>'w', -pady=>2, -padx=>2);
  $frame -> Checkbutton(-text	     => 'Plot spectra',
			-selectcolor => $config{colors}{single},
			-variable    => \$diff_params{components},
			-command     => sub{$widget{diff_replot}->invoke},
		       )
    -> grid(-row=>3, -column=>0, -columnspan=>2, -sticky=>'w', -pady=>2, -padx=>2);

  $diff -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');
  $diff -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{
		    $groups{$diff_params{standard}} ->
		      dispose("erase \@group diff___diff\n", $dmode);
		    &reset_window($diff, "difference spectra", 0);
		  })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>5);

  ## help button
  $diff -> Button(-text=>'Document section: difference spectra', @button_list,
		  -command=>sub{pod_display("analysis::diff.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  $frame = $diff -> Frame()
    -> pack(-side=>'bottom', -fill=>'x', -ipadx=>5);
  $widget{diff_savemarked} = $frame ->
    Button(-text=>'Make difference groups from all MARKED groups',  @button_list,
	   -command=>sub{
	     $diff_params{noplot} = 1;
	     $groups{$diff_params{standard}} -> plot_difference($groups{$current}, \%diff_params, $dmode, \%plot_features);
	     &diff_marked($space, \%diff_params);
	     $diff_params{noplot} = 0;
	   })
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -pady=>0, -padx=>0);
  $widget{diff_savemarkedi} = $frame ->
    Checkbutton(-text=>'Integrate?',
		-selectcolor=>$config{colors}{single},
		-variable=>\$diff_params{integrate_marked})
    -> pack(-side=>'right', -pady=>0, -padx=>0);


  $widget{diff_save} = $diff ->
    Button(-text=>'Make difference group',  @button_list,
	   -command=>sub{&make_diff_group($space, $diff_params{standard}, $current, \%diff_params); })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>5, -padx=>0);

  $widget{diff_replot} = $diff ->
    Button(-text=>'Replot',  @button_list,
	   -command=>sub{$groups{$diff_params{standard}} ->
			   plot_difference($groups{$current}, \%diff_params, $dmode, \%plot_features);
		       })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>5, -padx=>0);

  ## integration range
  $frame = $diff -> LabFrame(-label=>'Integrate difference spectra',
			     -labelside=>'acrosstop',
			     -foreground=>$config{colors}{activehighlightcolor},
			    )
    -> pack(-side=>'bottom', -fill=>'x', -pady=>5);
  my $fr = $frame -> Frame()
    -> pack(-side=>'top', -pady=>3);
  $fr -> Label(-text=> "Integration range:", -anchor=>'e',
	       -foreground=>$config{colors}{activehighlightcolor},
	      )
    -> pack(-side=>'left', -pady=>3, -fill=>'x');
  $widget{diff_xmin} = $fr -> Entry(-width=>7, -textvariable=>\$diff_params{xmin},
				    #-validate=>'all',
				    #-validatecommand=>[\&set_peak_variable, 'xmin'],
				   )
    -> pack(-side=>'left', -pady=>3);
  $grab{diff_xmin} = $fr -> Button(@pluck_button, @pluck,
				   -command=>sub{&pluck("diff_xmin");
						 my $e = $widget{diff_xmin}->get();
						 ($e = sprintf("%.3f", $e-$groups{$diff_params{standard}}->{bkg_e0}))
						   if ($diff_params{space} =~ /[en]/);
						 $widget{diff_xmin}->delete(0, 'end');
						 $widget{diff_xmin}->insert(0, $e);
						 if ($diff_params{xmin} > $diff_params{xmax}) {
						   ($diff_params{xmin}, $diff_params{xmax}) =
						     ($diff_params{xmax}, $diff_params{xmin});
						 };
						 $groups{$diff_params{standard}} ->
						   plot_difference($groups{$current}, \%diff_params,
								   $dmode, \%plot_features);
					       })
    -> pack(-side=>'left', -pady=>3);
  $fr -> Label(-text=> "to",
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left', -pady=>6);
  $widget{diff_xmax} = $fr -> Entry(-width=>7, -textvariable=>\$diff_params{xmax},
				    #-validate=>'all',
				    #-validatecommand=>[\&set_peak_variable, 'xmax'],
				   )
    -> pack(-side=>'left', -pady=>3);
  $grab{diff_xmax} = $fr -> Button(@pluck_button, @pluck,
				   -command=>sub{&pluck("diff_xmax");
						 my $e = $widget{diff_xmax}->get();
						 ($e = sprintf("%.3f", $e-$groups{$diff_params{standard}}->{bkg_e0}))
						   if ($diff_params{space} =~ /[en]/);
						 $widget{diff_xmax}->delete(0, 'end');
						 $widget{diff_xmax}->insert(0, $e);
						 if ($diff_params{xmin} > $diff_params{xmax}) {
						   ($diff_params{xmin}, $diff_params{xmax}) =
						     ($diff_params{xmax}, $diff_params{xmin});
						 };
						 $groups{$diff_params{standard}} ->
						   plot_difference($groups{$current}, \%diff_params,
								   $dmode, \%plot_features);
					       })
    -> pack(-side=>'left', -pady=>3);
  my $color = $config{colors}{activehighlightcolor};
  $widget{diff_integrate} = $fr ->
    Button(-text=>'Integrate',  @button_list,
	   -command=>sub{
	     Echonow("Integrating ...");
	     $top -> Busy(-recurse=>1);
	     ($diff_params{xmin},$diff_params{xmax}) = ($diff_params{xmax},$diff_params{xmin})
	       if ($diff_params{xmin} > $diff_params{xmax});
	     $diff_params{integral} =
	       sprintf("%.7f",
		       integrate( \&diff_interpolate,
				  $diff_params{xnot} + $diff_params{xmin},
				  $diff_params{xnot} + $diff_params{xmax},
				  6, 1e-8, \%diff_params ));
	     $widget{diff_integral_label} -> configure(-foreground=>$color);
	     $top -> Unbusy;
	     Echonow("Integrating ... done!");
	   })
      -> pack(-side=>'left', -pady=>3, -padx=>6);
  $fr = $frame -> Frame()
    -> pack(-side=>'bottom', -pady=>3);
  $widget{diff_integral_label} = $fr ->
    Label(-text=> "Intgerated area: ",
	  -foreground=>$config{colors}{disabledforeground})
    -> pack(-side=>'left', -pady=>3, -padx=>12);
  $diff_params{diff_integral_label} = $widget{diff_integral_label};
  $widget{diff_integral} = $fr -> Label(-width=>12,
					-textvariable=>\$diff_params{integral})
    -> pack(-side=>'left', -pady=>3);


  $groups{$diff_params{standard}} ->
    plot_difference($groups{$current}, \%diff_params, $dmode, \%plot_features);
  $last_plot=$space;
  $plotsel -> raise(lc(substr($sp{$space}, 0, 1)));
};


## make a new group object and copy the diff___diff arrays to this new
## group name
sub make_diff_group {
  my ($space, $standard, $other, $rhash) = @_;
  Error("Difference group aborted: You selected the same data group twice!"),
    return if ($standard eq $other);
  ##my $invert = ($$rhash{invert}) ? "-1*" : "";
  Echo ("Saving $standard - $other in $space space");
  ## get a group name
  my $group = join(" ", "Diff", $groups{$standard}->{label}, $groups{$other}->{label});
  my $label;
  ($group, $label) = group_name($group);
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  my $command = q{};
  ## make objects and copy the arrays from diff___diff to the new group
 SWITCH: {
    ($space eq 'e') and do {
      $groups{$group} -> make(is_xmu=>1, is_chi=>0, is_rsp=>0, is_qsp=>0,
			      is_diff=>1, bkg_flatten=>0,
			      bkg_e0  =>$groups{$standard}->{bkg_e0},
			      bkg_pre1=>$groups{$standard}->{bkg_pre1},
			      bkg_pre2=>$groups{$standard}->{bkg_pre2},
			      bkg_nor1=>$groups{$standard}->{bkg_nor1},
			      bkg_nor2=>$groups{$standard}->{bkg_nor2},
			      bkg_spl1=>$groups{$standard}->{bkg_spl1},
			      bkg_spl2=>$groups{$standard}->{bkg_spl2},
			      fft_kmax=>$groups{$standard}->{bkg_spl2},
			     );
      $groups{$group} -> make(bkg_spl1e=>$groups{$group}->k2e($groups{$group}->{bkg_spl1}));
      $groups{$group} -> make(bkg_spl2e=>$groups{$group}->k2e($groups{$group}->{bkg_spl2}));
      $command  = "set($group.energy = $standard.energy,\n";
      $command .= "    $group.xmu = diff___diff.xmu)\n";
      #$command .= "erase \@group diff___diff\n";
      $groups{$group} -> dispose($command, $dmode);
      last SWITCH;
    };
    ($space eq 'n') and do {
      $groups{$group} -> make(is_xmu=>1, is_chi=>0, is_rsp=>0, is_qsp=>0, is_nor=>1,
			      is_diff=>1, bkg_flatten=>0,
			      bkg_e0  =>$groups{$standard}->{bkg_e0},
			      bkg_pre1=>$groups{$standard}->{bkg_pre1},
			      bkg_pre2=>$groups{$standard}->{bkg_pre2},
			      bkg_nor1=>$groups{$standard}->{bkg_nor1},
			      bkg_nor2=>$groups{$standard}->{bkg_nor2},
			      bkg_spl1=>$groups{$standard}->{bkg_spl1},
			      bkg_spl2=>$groups{$standard}->{bkg_spl2},
			      fft_kmax=>$groups{$standard}->{bkg_spl2},
			     );
      $groups{$group} -> make(bkg_spl1e=>$groups{$group}->k2e($groups{$group}->{bkg_spl1}));
      $groups{$group} -> make(bkg_spl2e=>$groups{$group}->k2e($groups{$group}->{bkg_spl2}));
      $command  = "set($group.energy = $standard.energy,\n";
      my $ysuff = $groups{$standard}->{bkg_flatten} ? 'flat' : 'norm';
      ##my $ysuff = "norm";
      $command .= "    $group.xmu = diff___diff.$ysuff)\n";
      #$command .= "erase \@group diff___diff\n";
      $groups{$group} -> dispose($command, $dmode);
      last SWITCH;
    };
    ($space eq 'k') and do {
      $groups{$group} -> dispose("___x = ceil($standard.k)\n", 1);
      my $maxk = Ifeffit::get_scalar("___x");
      $groups{$group} -> make(is_xmu=>0, is_chi=>1, is_rsp=>0, is_qsp=>0,
			      is_diff=>1,
			      update_bkg=>0, fft_kmax=>sprintf("%.2f", $maxk));
      $command  = "set($group.k = $standard.k,\n";
      $command .= "    $group.chi = diff___diff.chi)\n";
      #$command .= "erase \@group diff___diff\n";
      $groups{$group} -> dispose($command, $dmode);
      last SWITCH;
    };
    ($space eq 'r') and do {
      $groups{$group} -> make(is_xmu=>0, is_chi=>0, is_rsp=>1, is_qsp=>0,
			      is_diff=>1);
      $command  = "set($group.r = $standard.r,\n";
      $command .= "    $group.chir_mag = diff___diff.chir_mag,\n";
      $command .= "    $group.chir_pha = diff___diff.chir_pha,\n";
      $command .= "    $group.chir_re  = diff___diff.chir_re,\n";
      $command .= "    $group.chir_im  = diff___diff.chir_im)\n";
      #$command .= "erase \@group diff___diff\n";
      $groups{$group} -> dispose($command, $dmode);
      last SWITCH;
    };
    ($space eq 'q') and do {
      $groups{$group} -> make(is_xmu=>0, is_chi=>0, is_rsp=>0, is_qsp=>1,
			      is_diff=>1);
      $command  = "set($group.q = $standard.q\n";
      $command .= "    $group.chiq_mag = diff___diff.chiq_mag,\n";
      $command .= "    $group.chiq_pha = diff___diff.chiq_pha,\n";
      $command .= "    $group.chiq_re  = diff___diff.chiq_re,\n";
      $command .= "    $group.chiq_im  = diff___diff.chiq_im)\n";
      #$command .= "erase \@group diff___diff\n";
      $groups{$group} -> dispose($command, $dmode);
      last SWITCH;
    };
  };
  $groups{$group} -> make(bkg_z    => $groups{$standard}->{bkg_z},
			  fft_edge => $groups{$standard}->{fft_edge});
  ## titles and the "file"
  push @{$groups{$group}->{titles}}, "Difference between $groups{$standard}->{label} and $groups{$other}->{label} in $space space";
  if ($$rhash{integral}) {
    push @{$groups{$group}->{titles}},
      sprintf("Integrated area from %s to %s : %s",
	      $$rhash{xmin}, $$rhash{xmax}, $$rhash{integral});
  };
  $groups{$group} -> put_titles();
  $groups{$group} -> make(file => "Difference between $groups{$standard}->{label} and $groups{$other}->{label} in $space space");
  ## and display it
  ++$line_count;
  $groups{$group} -> make(line=>$line_count);
  fill_skinny($list, $group, 1);
  Echo(@done);
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};



sub diff_interpolate {
  my $e = shift;
  my $rhash = shift;
  my $stan  = $$rhash{standard};
  my $xsuff = $$rhash{xsuff};
  my $ysuff = $$rhash{ysuff};
  $groups{$current} -> dispose("set ___x = splint($stan.$xsuff, diff___diff.$ysuff, $e)", 1);
  return Ifeffit::get_scalar('___x');
};


# adapted from Mastering Algorithms with Perl by Orwant, Hietaniemi,
# and Macdonald Chapter 16, p 632 to pass the diff_params hash to the
# function
#
# integrate() uses the Romberg algorithm to estimate the definite integral
# of the function $func (provided as a code reference) from $lo to $hi.
#
# The subroutine will compute roughly ($steps + 1) * ($steps + 2) / 2
# estimates for the integral, of which the last will be the most accurate.
#
# integrate() returns early if intermediate estimates change by less
# than $epsilon.
#
sub integrate {
    my ($func, $lo, $hi, $steps, $epsilon, $rhash) = @_;
    my ($h) = $hi - $lo;
    my ($i, $j, @r, $sum);
    my @est;

    # Our initial estimate.
    $est[0][0] = ($h / 2) * ( &{$func}( $lo, $rhash ) + &{$func}( $hi, $rhash ) );

    # Compute each row of the Romberg array.
    for ($i = 1; $i <= $steps; $i++) {

        $h /= 2;
        $sum = 0;

        # Compute the first column of the current row.
        for ($j = 1; $j < 2 ** $i; $j += 2) {
            $sum += &{$func}( $lo + $j * $h, $rhash );
        }
        $est[$i][0] = $est[$i-1][0] / 2 + $sum * $h;

        # Compute the rest of the columns in this row.
        for ($j = 1; $j <= $i; $j++) {
            $est[$i][$j] = ($est[$i][$j-1] - $est[$i-1][$j-1])
                / (4**$j - 1) + $est[$i][$j-1];
        }

        # Are we close enough?
        return $est[$i][$i] if $epsilon and
            abs($est[$i][$i] - $est[$i-1][$i-1]) <= $epsilon;
    }
    return $est[$steps][$steps];
}


sub diff_marked {

  my ($space, $rhash) = @_;
  my $stan = $$rhash{standard};
  my @areas;
  my @titles;
  my $j = 0;
  $top -> Busy(-recurse=>1);
  foreach my $g (&sorted_group_list) {
    next unless $marked{$g};
    next if ($g eq $stan);
				## verify this group
    my $ok = 1;
  SWITCH: {
      ($$rhash{space} =~ /[en]/) and do {
	($ok = 0) unless $groups{$g}->{is_xmu};
	last SWITCH;
      };
      ($$rhash{space} eq 'k') and do {
	($ok = 0) unless ($groups{$g}->{is_xmu} or $groups{$g}->{is_chi});
	last SWITCH;
      };
      ($$rhash{space} eq 'r') and do {
	($ok = 0) if $groups{$g}->{is_qsp};
	last SWITCH;
      };
    };
    next unless $ok;

    ++$j;
    set_properties(0, $g, 0);

				## integrate
    if ($$rhash{integrate_marked}) {
      ($$rhash{xmin},$$rhash{xmax}) = ($$rhash{xmax},$$rhash{xmin})
	  if ($$rhash{xmin} > $$rhash{xmax});
      $$rhash{integral} =
	sprintf("%.7f",
		integrate( \&diff_interpolate,
			   $$rhash{xnot} + $$rhash{xmin},
			   $$rhash{xnot} + $$rhash{xmax},
			   6, 1e-8, $rhash ));
      my $color = $config{colors}{activehighlightcolor};
      $widget{diff_integral_label} -> configure(-foreground=>$color);
      push @areas, $$rhash{integral};
      push @titles, "point number $j: " . $groups{$g}->{label};
    };

				## make difference group
    &make_diff_group($space, $$rhash{standard}, $current, $rhash);
  };
  unless ($j) {
    $top -> Unbusy;
    Echo("No valid marked groups!");
    return;
  };

  if ($$rhash{integrate_marked}) {
    ##print join(" ", @areas), $/;
    my @x = ();
    my $i = 0;
    foreach (@areas) { push @x, ++$i };
    my ($group, $label) = group_name("d___iff");
    Ifeffit::put_array("$group.energy", \@x);
    Ifeffit::put_array("$group.det", \@areas);
    $groups{$group} = Ifeffit::Group -> new(group=>$group,
					    label=>"Integrated areas");
    $groups{$group} -> make(is_xmu => 0, is_chi => 0, is_rsp => 0, is_qsp => 0,
			    not_data => 1, bkg_e0 => 1, bkg_eshift => 0);
    push @{$groups{$group}->{titles}}, "Integrated areas from $$rhash{xmin} to $$rhash{xmax}";
    foreach my $t (@titles) { push @{$groups{$group}->{titles}}, $t };
    $groups{$group} -> put_titles();
    $groups{$group} -> make(file => "Integrated areas");
    my @save = ($plot_features{emin}, $plot_features{emax});
    ($plot_features{emin}, $plot_features{emax}) = (0, $i);
    $groups{$group} -> plotE('em',$dmode,\%plot_features, \@indicator);
    ($plot_features{emin}, $plot_features{emax}) = @save;
    ## and display it
    ++$line_count;
    $groups{$group} -> make(line=>$line_count);
    fill_skinny($list, $group, 1);
  };
  $top -> Unbusy;
};

## END OF DIFFERENCE SPECTRA SUBSECTION
##########################################################################################

## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2009 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  log-ratio/phase-difference analysis


## missing features in the log-ratio interface:
##  -- widget for window functions


## pop-up a palette for performing log-ratio/phase-difference analysis
## between two scans
sub log_ratio {
  Echo("No data!"), return unless $current;
  my $color = $plot_features{c1};
  my %widg;
  my @cumul = (0, 0, 0, 0, 0);
  my @delta = (0, 0, 0, 0, 0);

  Echo("No data!"), return if ($current eq "Default Parameters");

  my @keys = ();
  foreach my $k (&sorted_group_list) {
    (($groups{$k}->{is_xmu}) or ($groups{$k}->{is_chi})) and push @keys, $k;
  };
  Echo("You need two or more xmu or chi groups to do log-ratio/phase-difference analysis"),
    return unless ($#keys >= 1);

  $widg{standard} = $keys[0];
  $widg{keys} = \@keys;
  my $standard_label = "1:".$groups{$widg{standard}}->{label};
  if ($widg{standard} eq $current) {	# make sure $current is sensible given
    set_properties(1, $keys[1], 0);     # that $keys[0] is the standard
    # adjust the view
    my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
    ($here < 0) and ($here = 0);
    my $full = ($list->bbox(@skinny_list))[3] + 5;
    $list -> yview('moveto', $here/$full);
  };
  $fat_showing = 'lograt';
  $hash_pointer = \%widg;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $lr = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$lr -> packPropagate(0);
  $which_showing = $lr;

  ## select the standard
  my $frame = $lr -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x');

  $frame -> Label(-text=>"Log-Ratio/Phase-Difference Analysis",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -columnspan=>2);

  $frame -> Label(-text=>"Standard: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -pady=>2);

  $widget{lr_menu} = $frame -> BrowseEntry(-variable => \$standard_label,
					   @browseentry_list,
					   -browsecmd => sub {
					     my $text = $_[1];
					     my $this = $1 if ($text =~ /^(\d+):/);
					     Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless $this;
					     $this -= 1;
					     $widg{standard}=$widg{keys}->[$this];
					     #$standard_lab="$groups{$s}->{label} ($s)";
					     &reset_lr_data(\%widg, $widg{standard}, $current);
					     @cumul = (1, 0, 0, 0, 0);
					   })
    -> grid(-row=>1, -column=>1, -sticky=>'w', -pady=>2);
  my $i = 1;
  foreach my $s (@keys) {
    $widget{lr_menu} -> insert("end", "$i: $groups{$s}->{label}");
    ++$i;
  };


  ## select the unknown group
  $frame -> Label(-text=>"Unknown: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>2, -column=>0, -sticky=>'e', -pady=>2);
  $widget{lr_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					-foreground=>$config{colors}{button})
    -> grid(-row=>2, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);

  $lr -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');
  $lr -> Button(-text=>'Return to the main window',  @button_list,
		-background=>$config{colors}{background2},
		-activebackground=>$config{colors}{activebackground2},
		-command=>sub{$groups{$current}->dispose("clean_lograt", $dmode);
			      &reset_window($lr, "log-ratio analysis", 0);
			      set_properties(1, $current, 0);
			    })
    -> pack(-side=>'bottom', -fill=>'x');

  ## help button
  $lr -> Button(-text=>'Document section: log ratio/phase difference analysis', @button_list,
		-command=>sub{pod_display("analysis::lr.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  ## frame with fit params
  $frame = $lr -> LabFrame(-label      => 'Fourier transform and fitting parameters',
			   -foreground => $config{colors}{activehighlightcolor},
			   -labelside  => 'acrosstop')
    -> pack(-fill=>'x', -padx=>3);

  $frame -> Label(-text=>"k-range of FT:  ",
		 )
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widget{lr_kmin} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_kmin']
				    )
    -> grid(-row=>0, -column=>1);
  $grab{lr_kmin} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_kmin'])
    -> grid(-row=>0, -column=>2);
  $frame -> Label(-text=>" :   ")
    -> grid(-row=>0, -column=>3);
  $widget{lr_kmax} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_kmax']
				    )
    -> grid(-row=>0, -column=>4);
  $grab{lr_kmax} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_kmax'])
    -> grid(-row=>0, -column=>5);

  $frame -> Label(-text=>"k-weight:  ",
		 )
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $widget{lr_kw} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				   -validate=>'key',
				   -validatecommand=>[\&set_lr_variable, 'lr_kw']
				  )
    -> grid(-row=>1, -column=>1);
  $frame -> Label(-text=>"dk:  ",
		 )
    -> grid(-row=>1, -column=>3, -sticky=>'e');
  $widget{lr_dk} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				   -validate=>'key',
				   -validatecommand=>[\&set_lr_variable, 'lr_dk']
				  )
    -> grid(-row=>1, -column=>4);

  $frame -> Label(-text=>"R-range of BFT:  ",
		 )
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $widget{lr_rmin} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_rmin']
				    )
    -> grid(-row=>2, -column=>1);
  $grab{lr_rmin} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_rmin'])
    -> grid(-row=>2, -column=>2);
  $frame -> Label(-text=>" :   ")
    -> grid(-row=>2, -column=>3,);
  $widget{lr_rmax} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_rmax']
				    )
    -> grid(-row=>2, -column=>4);
  $grab{lr_rmax} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_rmax'])
    -> grid(-row=>2, -column=>5);

  $frame -> Label(-text=>"2pi jump:  ",
		 )
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $widget{lr_npi} = $frame -> NumEntry(-width=>4, -orient=>'horizontal',
				       -foreground=>$config{colors}{foreground})
    -> grid(-row=>3, -column=>1, -sticky=>'w');
  $frame -> Label(-text=>"dr:  ",
		 )
    -> grid(-row=>3, -column=>3, -sticky=>'e');
  $widget{lr_dr} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				   -validate=>'key',
				   -validatecommand=>[\&set_lr_variable, 'lr_dr']
				  )
    -> grid(-row=>3, -column=>4, -sticky=>'w');

  $frame -> Label(-text=>"k-range of fit:  ",
		 )
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $widget{lr_fmin} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_fmin']
				    )
    -> grid(-row=>4, -column=>1);
  $grab{lr_fmin} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_fmin'])
    -> grid(-row=>4, -column=>2);
  $frame -> Label(-text=>" :   ")
    -> grid(-row=>4, -column=>3,);
  $widget{lr_fmax} = $frame -> Entry(-width=>8, -font=>$config{fonts}{entry},
				     -validate=>'key',
				     -validatecommand=>[\&set_lr_variable, 'lr_fmax']
				    )
    -> grid(-row=>4, -column=>4);
  $grab{lr_fmax} = $frame -> Button(@pluck_button, @pluck, -command=>[\&pluck, 'lr_fmax'])
    -> grid(-row=>4, -column=>5);

  ##   $frame -> Label(-text=>"window function:")
  ##     -> grid(-row=>5, -column=>0, -sticky=>'e');
  ##   $widget{lr_win} = $frame -> Optionmenu(-font=>$config{fonts}{small},
  ## 					 -textvariable => \$menus{fft_win},)
  ##     -> grid(-row=>5, -column=>1, -columnspan=>4, -sticky=>'w');
  ##   foreach my $i ($setup->Windows) {
  ##     $widget{lr_win} -> command(-label => $i,
  ## 			       -command=>sub{$menus{fft_win}=$i;
  ## 					     project_state(0);
  ## 					     $groups{$current}->make(fft_win=>$i,
  ## 								     update_fft=>1)});
  ##   };

  ## frame with fit button
  $frame = $lr -> Frame(-borderwidth=>0, -relief=>'flat')
    -> pack(-fill=>'x', -padx=>3, -pady=>0, -ipadx=>2, -ipady=>0);

  $widget{lr_fit} =
  $frame -> Button(-text=>'Fit',  @button_list,
		   -command=>sub{my $ok = &do_lr_fit($widg{standard}, $current);
				 return unless $ok;
				 ## post cumulant values;
				 @cumul[0..2] =
				   map {sprintf("%.5f", Ifeffit::get_scalar("c___" . $_))}
				     (0 .. 2);
				 @cumul[3..4] =
				   map {sprintf("%.8f", Ifeffit::get_scalar("c___" . $_))}
				     (3 .. 4);
				 @delta[0..2] =
				   map {sprintf("%.5f", Ifeffit::get_scalar("delta_c___" . $_))}
				     (0 .. 2);
				 @delta[3..4] =
				   map {sprintf("%.8f", Ifeffit::get_scalar("delta_c___" . $_))}
				     (3 .. 4);
				 $widg{l0} ->
				   configure(-text=>sprintf("%.5f +/- %.5f",
							    exp($cumul[0]),
							    $delta[0]*exp($cumul[0])));
				 map {$widg{"l".$_} ->
					configure(-text=>"$cumul[$_] +/- $delta[$_]")} (1..4);
				 map {$widget{'lr_'.$_}->configure(-state=>'normal')} (qw(lr pd save log));
			       })
    -> pack(-expand=>1, -fill=>'x');


  ## frame with plot buttons
  $frame = $lr -> LabFrame(-label      => 'Plot standard and unknown in',
			   -foreground => $config{colors}{activehighlightcolor},
			   -labelside  => 'acrosstop')
    -> pack(-side=>'bottom', -fill=>'x', -padx=>3, -pady=>2, -ipadx=>2, -ipady=>2);

  $widget{lr_plotk} =
  $frame -> Button(-text=>'k',  @button_list,
		   -command=>sub{
		     $groups{$widg{standard}}->plot_marked($plot_features{k_w}, $dmode, \%groups,
							   {$widg{standard}=>1, $current=>1},
							   \%plot_features, $list, \@indicator);
		     $last_plot='k';
		     $last_plot_params = [$current, 'marked', 'k', $plot_features{k_w}];
		     $groups{$widg{standard}}->plot_window(0, 'k', $dmode, $config{plot}{c2}, \%plot_features);
		     map { $grab{$_} -> configure(-state=>'normal') }
		       (qw(lr_kmin lr_kmax lr_fmin lr_fmax));
		     map { $grab{$_} -> configure(-state=>'disabled') }
		       (qw(lr_rmin lr_rmax));
		     })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $widget{lr_plotr} =
  $frame -> Button(-text=>'R',  @button_list,
		   -command=>sub{
		     $groups{$widg{standard}}->plot_marked($plot_features{r_marked}, $dmode, \%groups,
							   {$widg{standard}=>1, $current=>1},
							   \%plot_features, $list, \@indicator);
		     $last_plot='r';
		     $last_plot_params = [$current, 'marked', 'r', $plot_features{r_marked}];
		     $groups{$widg{standard}}->plot_window(0, 'r', $dmode, $config{plot}{c2}, \%plot_features);
		     map { $grab{$_} -> configure(-state=>'disabled') }
		       (qw(lr_kmin lr_kmax lr_fmin lr_fmax));
		     map { $grab{$_} -> configure(-state=>'normal') }
		       (qw(lr_rmin lr_rmax));
		   })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $widget{lr_plotq} =
  $frame -> Button(-text=>'q',  @button_list,
		   -command=>sub{
		     $groups{$widg{standard}}->plot_marked($plot_features{q_marked}, $dmode, \%groups,
							   {$widg{standard}=>1, $current=>1},
							   \%plot_features, $list, \@indicator);
		     $last_plot='q';
		     $last_plot_params = [$current, 'marked', 'q', $plot_features{q_marked}];
		     $groups{$widg{standard}}->plot_window(0, 'q', $dmode, $config{plot}{c2}, \%plot_features);
		     map { $grab{$_} -> configure(-state=>'normal') }
		       (qw(lr_kmin lr_kmax lr_fmin lr_fmax));
		     map { $grab{$_} -> configure(-state=>'disabled') }
		       (qw(lr_rmin lr_rmax));
		   })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');


  ## frame with plot buttons for results
  $frame = $lr -> Frame(-borderwidth=>0, -relief=>'flat')
    -> pack(-side=>'bottom', -fill=>'x', -padx=>3, -pady=>2);

  $widget{lr_save} = $frame -> Button(-text=>'Save ratio data & fit',  @button_list,
				      -command=>sub{&save_lr_fit($widg{standard}, \@cumul, \@delta)},
				      -width=>1,
				      -state=>'disabled')
    -> pack(-expand=>1, -fill=>'x', -side=>'left');
  $widget{lr_log} = $frame -> Button(-text=>'Write log file',  @button_list,
				     -command=>sub{
				       my $types = [['Log-ratio fit logs', '.lr_log'], ['All Files', '*']];
				       my $path = $current_data_dir || Cwd::cwd;
				       my $initial = $groups{$current}->{label} . ".lr_log";
				       ($initial =~ s/[\\:\/\*\?\'<>\|]/_/g); # if ($is_windows);
				       my $file = $top ->
					 getSaveFile(-filetypes=>$types,
						     #(not $is_windows) ?
						     #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
						     -initialdir=>$path,
						     -initialfile=>$initial,
						     -title => "Athena: Save log-ratio log file");
				       return unless $file;
				       my ($name, $pth, $suffix) = fileparse($file);
				       $current_data_dir = $pth;
				       open LOG, ">".$file or do {
					 Error("You cannot write a log to \"$file\"."); return
				       };
				       print LOG &lr_log($widg{standard}, \@cumul, \@delta);
				       close LOG;
				     },
				     -width=>1,
				     -state=>'disabled')
    -> pack(-expand=>1, -fill=>'x', -side=>'left');


  ## frame with plot buttons for results
  $frame = $lr -> Frame(-borderwidth=>0, -relief=>'flat')
    -> pack(-side=>'bottom', -fill=>'x', -padx=>3, -pady=>2);

  $widget{lr_lr} = $frame -> Button(-text=>'Plot log-ratio + fit',  @button_list,
				    -command=>sub{
				      my ($qmin, $qmax) =
					($widget{lr_fmin}->get(), $widget{lr_fmax}->get()+1);
				      $groups{$widg{standard}} ->
					dispose("plot_lograt $widg{standard} \"$groups{$widg{standard}}->{label}\" \"$groups{$current}->{label}\" $qmax", $dmode);
				      $last_plot='q';
				      map { $grab{$_} -> configure(-state=>'normal') }
					(qw(lr_kmin lr_kmax lr_fmin lr_fmax));
				      map { $grab{$_} -> configure(-state=>'disabled') }
					(qw(lr_rmin lr_rmax));
				    },
				    -width=>1,
				    -state=>'disabled')
    -> pack(-expand=>1, -fill=>'x', -side=>'left');
  $widget{lr_pd} = $frame -> Button(-text=>'Plot phase-difference + fit',  @button_list,
				    -command=>sub{
				      my ($qmin, $qmax) =
					($widget{lr_fmin}->get(), $widget{lr_fmax}->get()+1);
				      $groups{$widg{standard}} ->
					dispose("plot_phdiff $widg{standard} \"$groups{$widg{standard}}->{label}\" \"$groups{$current}->{label}\" $qmax", $dmode);
				      $last_plot='q';
				      map { $grab{$_} -> configure(-state=>'normal') }
					(qw(lr_kmin lr_kmax lr_fmin lr_fmax));
				      map { $grab{$_} -> configure(-state=>'disabled') }
					(qw(lr_rmin lr_rmax));
				    },
				    -width=>1,
				    -state=>'disabled')
    -> pack(-expand=>1, -fill=>'x', -side=>'left');

  ## frame with results
  $frame = $lr -> LabFrame(-label      => 'Fit Results',
			   -foreground => $config{colors}{activehighlightcolor},
			   -labelside  => 'acrosstop')
    -> pack(-fill=>'x', -padx=>3);
  $frame -> Label(-text=>"Zeroth: ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widg{l0} = $frame -> Label(-text=>exp($cumul[0]), -font => $config{fonts}{small},)
    -> grid(-row=>0, -column=>1, -sticky=>'w');
  $frame -> Label(-text=>"First: ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $widg{l1} = $frame -> Label(-text=>$cumul[1], -font => $config{fonts}{small},)
    -> grid(-row=>1, -column=>1, -sticky=>'w');
  $frame -> Label(-text=>"Second: ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $widg{l2} = $frame -> Label(-text=>$cumul[2], -font => $config{fonts}{small},)
    -> grid(-row=>2, -column=>1, -sticky=>'w');
  $frame -> Label(-text=>"     ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>1, -column=>2, -sticky=>'e');
  $frame -> Label(-text=>"Third: ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>1, -column=>3, -sticky=>'e');
  $widg{l3} = $frame -> Label(-text=>$cumul[3], -font => $config{fonts}{small},)
    -> grid(-row=>1, -column=>4, -sticky=>'w');
  $frame -> Label(-text=>"Fourth: ", -foreground=>$config{colors}{highlightcolor})
    -> grid(-row=>2, -column=>3, -sticky=>'e');
  $widg{l4} = $frame -> Label(-text=>$cumul[4], -font => $config{fonts}{small},)
    -> grid(-row=>2, -column=>4, -sticky=>'w');

  ## set initial data
  &reset_lr_data(\%widg, $widg{standard}, $current);
  foreach my $widg (qw(lr_fmin lr_fmax)) {
    $widget{$widg} -> configure(-validate=>'none');
    $widget{$widg} -> delete(qw/0 end/);
    $widget{$widg} -> insert(0, ($widg =~ /n$/) ? 3 : 12);
    $widget{$widg} -> configure(-validate=>'key');
  };

  Echo("Reminder: Data should be aligned BEFORE doing log-ratio analysis.");
  $plotsel -> raise('k');
  $top -> update;
};


sub set_lr_variable {
  my ($k, $entry, $prop) = (shift, shift, shift);
  ($entry =~ /^\s*$/) and ($entry = 0);	# error checking ...
  ($entry =~ /^\s*-$/) and return 1;	# error checking ...
  ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
  return 1;
};

sub do_lr_fit {
  my ($standard, $other) = @_;

  ## some error checking
  Error("Log-ratio fit aborted: You selected the same data group as standard and unknown."),
    return 0 if ($standard eq $other);
  Error("Log-ratio fit aborted: " . $groups{$other}->{label} . " is not an xmu or chi group."),
    return 0 unless (($groups{$other}->{is_xmu}) or ($groups{$other}->{is_chi}));

  Echo("Doing log-ratio/phase-difference fit ...");
  $top -> Busy;
  ## set standard and unknown FT param values
  foreach my $k (qw(kmin kmax kw dk rmin rmax dr)){
    my $widg = "lr_$k";
    my $key = ($k =~ /r/) ? "bft_$k" : "fft_$k";
    $groups{$standard}->make($key => $widget{$widg}->get());
    $groups{$other}->make($key => $widget{$widg}->get());
  };
  ## bring both up to date in q-space
  $groups{$standard}->do_fft($dmode, \%plot_features);
  $groups{$standard}->do_bft($dmode);
  $groups{$other}->do_fft($dmode, \%plot_features);
  $groups{$other}->do_bft($dmode);
  ## call LR/PD fit macro
  my ($qmin, $qmax, $npi) = ($widget{lr_fmin}->get(), $widget{lr_fmax}->get(),
			     $widget{lr_npi}->get(), );
  $groups{$standard}-> dispose("do_lograt $standard $other $qmin $qmax $npi", $dmode);
  ## plot phase diff
  $qmax += 1;
  $groups{$standard} ->
    dispose("plot_lograt $standard \"$groups{$standard}->{label}\" \"$groups{$current}->{label}\" $qmax", $dmode);
  $last_plot='q';
  $top -> Unbusy;
  Echo("Doing log-ratio/phase-difference fit ... done!");
  1;
};

sub save_lr_fit {
  my ($standard, $r_c, $r_d) = @_;
  my $types = [['Log ratio fits', '.lr'], ['All Files', '*'],];
  my $path = $current_data_dir || Cwd::cwd;
  my $initial = $groups{$current}->{label} . ".lr";
  ($initial =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$initial,
				 -title => "Athena: Save log-ratio fit");
  return unless $file;
  ## make sure I can write to $file
  open F, ">".$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  close F;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  my $titles = &lr_log($standard, $r_c, $r_d);
  my $i = 0;
  foreach my $t (split(/\n/, $titles)) {
    next if ($t =~ /^\s*$/);
    ++$i;
    Ifeffit::put_string("\$l___r_title_$i", $t);
  };
  my $command = "write_data(file=\"$file\", ";
  $command   .= "           \$l___r_title_*, $standard.q, c___.ratio, c___.even, c___.diff, c___.odd)";
  $groups{$standard} -> dispose($command, $dmode);
  foreach (1 .. $i) {
    $groups{$standard} -> dispose("erase \$l___r_title_$_", $dmode);
  };
};

sub lr_log {
  my ($standard, $r_c, $r_d) = @_;
  my $string = "Log-ratio/phase-difference between " . $groups{$current}->{label} .
    " (the unknown)\n";
  $string .= "and " . $groups{$standard}->{label} . " (the standard)\n\n";
  $string .= sprintf("Zeroth cumulant = %.5f +/- %.5f\n",  exp($$r_c[0]), $$r_d[0]*exp($$r_c[0]));
  $string .= "First cumulant  = $$r_c[1] +/- $$r_d[1]\n";
  $string .= "Second cumulant = $$r_c[2] +/- $$r_d[2]\n";
  $string .= "Third cumulant  = $$r_c[3] +/- $$r_d[3]\n";
  $string .= "Fourth cumulant = $$r_c[4] +/- $$r_d[4]\n\n";
  $string .= sprintf("Forward FT parameters: [%.2f:%.2f], dk=%.2f, kw=%s\n",
		     $widget{lr_kmin}->get,
		     $widget{lr_kmax}->get,
		     $widget{lr_dk}->get,
		     $widget{lr_kw}->get, );
  $string .= sprintf("Backward FT parameters: [%.2f:%.2f]  dr=%.2f\n",
		     $widget{lr_rmin}->get,
		     $widget{lr_rmax}->get,
		     $widget{lr_dr}->get,);
  $string .= sprintf("Fitting range in q: [%.2f:%.2f]\n",
		     $widget{lr_fmin}->get,
		     $widget{lr_fmax}->get,);
  return $string;
};

sub reset_lr_data {
  my ($r_widg, $standard, $other) = @_;
  ## reset plot buttons
  map {$widget{'lr_'.$_}->configure(-state=>'disabled')} (qw(lr pd save log));
  ## plot new data
  $groups{$standard}->plot_marked($plot_features{k_w}, $dmode, \%groups,
				  {$standard=>1, $other=>1}, \%plot_features, $list, \@indicator);
  $last_plot='k';
  $last_plot_params = [$current, 'marked', 'k', $plot_features{k_w}];
  $groups{$standard}->plot_window(0, 'k', $dmode, $config{plot}{c2}, \%plot_features);
  ## enable/disable pluck buttons for k
  map { $grab{$_} -> configure(-state=>'normal') }
    (qw(lr_kmin lr_kmax lr_fmin lr_fmax));
  map { $grab{$_} -> configure(-state=>'disabled') }
    (qw(lr_rmin lr_rmax));
  ## reset FT params
  foreach my $k (qw(kmin kmax kw dk rmin rmax dr)){
    my $widg = "lr_$k";
    my $key = ($k =~ /r/) ? "bft_$k" : "fft_$k";
    $widget{$widg} -> configure(-validate=>'none');
    $widget{$widg} -> delete(qw/0 end/);
    $widget{$widg} -> insert(0, $groups{$standard}->{$key});
    $widget{$widg} -> configure(-validate=>'key');
  };
  ## $widget{lr_win} ->
  ## reset cumulants
  my @cumul = (1, 0, 0, 0, 0);
  map {$$r_widg{"l".$_}->configure(-text=>$cumul[$_])} (0 .. 4);
};



## END OF LOG-RATIO/PHASE_DIFFERENCE SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2009 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  near edge peak fitting.


sub peak_fit {
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{peakfit}{emin};
  $plot_features{emax} = $config{peakfit}{emax};
  project_state($ps);		# don't toggle if currently saved
  my $npeaks = $config{peakfit}{maxpeaks};
  my @peaks = ();
  my @param_list = ("amp", "width");

  $fat_showing = 'peakfit';
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $peak = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$peak -> packPropagate(0);
  $which_showing = $peak;

  my %peak_params = (function	     => 'atan', function_choice => 'atan',
		     fit_e	     => 0,
		     fit_a	     => 1,
		     fit_w	     => 1,
		     emin	     => $config{peakfit}{fitmin},
		     emax	     => $config{peakfit}{fitmax},
		     enot	     => $groups{$current}->{bkg_e0},
		     amp	     => 1, width => 1,
		     plot_components => $config{peakfit}{components},
		     plot_difference => $config{peakfit}{difference},
		     mark_centroids  => $config{peakfit}{centroids},
		     toplevel	     => $peak,
		     deltas	     => []);
  #my %function_map = (arctangent=>'atan', None=>'None', 'error function'=>'erf',
  #		      Gaussian=>'gauss', Lorentzian=>'loren', none=>'none',
  #		      'pseudo-Voight'=>'pvoight');
  $hash_pointer = \%peak_params;
  my $peak_results;

  $peak -> Label(-text=>"Peak fitting with lineshapes",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');
  my $params_frame = $peak -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -ipadx=>5);
  my $frame = $params_frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -ipadx=>5);
  $frame -> Label(-text=>'Group: ',
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> pack(-side=>'left');
  $widget{peak_group} = $frame -> Label(-text=>$groups{$current}->{label},
					-foreground=>$config{colors}{button},
					#-width=>15, -justify=>'left'
				       )
    -> pack(-side=>'left', -padx=>3, -anchor=>'w');


  ## pack the next few in reverse order so they go flush up against
  ## the right hand side
  $grab{peak_emax} = $frame -> Button(@pluck_button, @pluck,
				      -command=>sub{&pluck("peak_emax");
						    my $e = $widget{peak_emax}->get();
						    $e = sprintf("%.3f", $e-$peak_params{enot});
						    $widget{peak_emax}->delete(0, 'end');
						    $widget{peak_emax}->insert(0, $e);
						  })
    -> pack(-side=>'right', -pady=>3);
  $widget{peak_emax} = $frame -> Entry(-width=>5, -textvariable=>\$peak_params{emax},
				     -validate=>'all',
				     -validatecommand=>[\&peak_set_variable, 'emax'],
				    )
    -> pack(-side=>'right', -pady=>3);
  $frame -> Label(-text=> "to",
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'right', -pady=>6);
  $grab{peak_emin} = $frame -> Button(@pluck_button, @pluck,
				      -command=>sub{&pluck("peak_emin");
						    my $e = $widget{peak_emin}->get();
						    $e = sprintf("%.3f", $e-$peak_params{enot});
						    $widget{peak_emin}->delete(0, 'end');
						    $widget{peak_emin}->insert(0, $e);
						  })
    -> pack(-side=>'right', -pady=>3);
  $widget{peak_emin} = $frame -> Entry(-width=>5, -textvariable=>\$peak_params{emin},
				     -validate=>'all',
				     -validatecommand=>[\&peak_set_variable, 'emin'],
				    )
    -> pack(-side=>'right', -pady=>3);
  $frame -> Label(-text=> "Fitting range:",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> pack(-side=>'right', -pady=>3, -fill=>'x');



  $frame = $params_frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -ipadx=>5);

  $widget{peak_components} = $frame ->
    Checkbutton(-text=>'Plot components', -selectcolor=>$config{colors}{single},
		-variable=>\$peak_params{plot_components})
      -> pack(-side=>'left', -padx=>5);#, -expand=>1, -anchor=>'w');
  $widget{peak_difference} = $frame ->
    Checkbutton(-text=>'Plot difference', -selectcolor=>$config{colors}{single},
		-variable=>\$peak_params{plot_difference})
      -> pack(-side=>'left', -padx=>5);#, -expand=>1, -anchor=>'center');
  $widget{peak_show} = $frame ->
    Checkbutton(-text=>'Mark centroids', -selectcolor=>$config{colors}{single},
		-command=>sub{$peak_params{mark_centroids} and
				peak_mark_centroids($current,\%peak_params,\@peaks);},
		-variable=>\$peak_params{mark_centroids})
      -> pack(-side=>'left', -padx=>5);


  $peak -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{
		    $groups{$current}->dispose("erase \@group p___eak", $dmode);
		    $groups{$current}->dispose("erase p___eak_enot p___eak_amp p___eak_width",
					       $dmode);
		    foreach my $ipk (0 .. $#peaks) {
		      my $i = $ipk+1;
		      $groups{$current}->dispose("erase p___eak_e$i p___eak_a$i p___eak_w$i",
						 $dmode);
		    };
		    &reset_window($peak, "peak fitting", \@save);
		  })
    -> pack(-side=>'bottom', -fill=>'x', -padx=>5, -pady=>5);

  ## help button
  $peak -> Button(-text=>'Document section: peak fitting', @button_list,
		   -command=>sub{pod_display("analysis::peak.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  ## frame with buttons in
  my $nb = $peak -> NoteBook(-backpagecolor=>$config{colors}{background},
			     -inactivebackground=>$config{colors}{inactivebackground},)
    -> pack(-side=>'top', -expand=>1, -fill=>'y');

  ## step function
  #my $lab = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
  #  -> pack(-side=>'top', -expand=>1, -fill=>'both');

  my %nc;
  $nc{params} = $nb -> add('params', -label=>'Parameters', -anchor=>'center',);

  ## there should be a Pane here
  my $pane = $nc{params} -> Scrolled('Pane', -relief=>'groove', -borderwidth=>2,
				     -scrollbars=>'oe')
    -> pack(-expand=>1, -fill=>'y');
  $pane->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});

  my $hlist = $pane -> HList(-columns=>10, -header=>1, -width=>65, -height=>18,
			     -selectborderwidth=>0, -selectbackground=>
			     $config{colors}{activebackground} )
    -> pack(-expand=>1, -fill=>'y', -anchor=>'n');
  my $style = $hlist ->
    ItemStyle('text', -foreground=>$config{colors}{activehighlightcolor},
	      -font=>$config{fonts}{smbold},
	      -anchor=>'center');
  my $ih = 0;
  foreach my $t ('Function', 'Centroid', '', 'Fit', ' ',
		 'Amp.', 'Fit', ' ', 'Width', 'Fit') {
    $hlist->headerCreate($ih++, -headerbackground=>$config{colors}{background},
			 -itemtype=>'text', -style=>$style,
			 -text=>=>$t);
  };
  $hlist->add(1);

  $widget{peak_function} = $hlist -> Optionmenu(-textvariable => \$peak_params{function_choice},
						-borderwidth=>1, -width=>5);
  foreach my $f ('none', 'atan', 'erf', 'CL') {
    $widget{peak_function}
      -> command(-label => $f, -state=>($f =~ /CL/) ? 'disabled' : 'normal',
		 -command=>sub{
		   $peak_params{function_choice} = $f;
		 SWITCH: {
		     $peak_params{function} = 'none', last SWITCH if ($f eq 'none');
		     $peak_params{function} = 'atan', last SWITCH if ($f eq 'atan');
		     $peak_params{function} = 'erf',  last SWITCH if ($f eq 'erf');
		     $peak_params{function} = 'CL',   last SWITCH if ($f eq 'CL');
		   };
		   foreach my $p (@param_list) {
		     $peak_params{$p} = $widget{"peak_$p"}->get();
		   };
		   #&peak_do_fit($current, \%peak_params, $peak_results, @peaks);
		 });
  };
  $hlist->itemCreate(1, 0, -itemtype=>'window', -widget=>$widget{peak_function});
  $widget{peak_enot} = $hlist -> Entry(-width=>8, -textvariable=>\$peak_params{enot},
				     -validate=>'all',
				     -validatecommand=>[\&peak_set_variable, 'enot'],
				    );
  $hlist->itemCreate(1, 1, -itemtype=>'window', -widget=>$widget{peak_enot});
  my $inner =  $hlist -> Frame();
  $hlist->itemCreate(1, 2, -itemtype=>'window', -widget=>$inner);
  $grab{peak_enot} = $inner -> Button(@pluck_button, @pluck,
				      -command=>sub{&pluck("peak_enot");}) -> pack();
  $widget{peak_fit_e} = $hlist -> Checkbutton(-text=>"",
					      -selectcolor=>$config{colors}{single},
					      -variable=>\$peak_params{fit_e});
  $hlist->itemCreate(1, 3, -itemtype=>'window', -widget=>$widget{peak_fit_e});
  ##$hlist->itemCreate(1, 2, -itemtype=>'window', -widget=>$grab{peak_enot});
  $widget{peak_amp} = $hlist -> Entry(-width=>6, -textvariable=>\$peak_params{amp},
				      -validate=>'all',
				      -validatecommand=>[\&peak_set_variable, 'amp'],
				     );
  $hlist->itemCreate(1, 5, -itemtype=>'window', -widget=>$widget{peak_amp});
  $widget{peak_fit_a} = $hlist -> Checkbutton(-text=>"",
					      -selectcolor=>$config{colors}{single},
					      -variable=>\$peak_params{fit_a});
  $hlist->itemCreate(1, 6, -itemtype=>'window', -widget=>$widget{peak_fit_a});
  $widget{peak_width} = $hlist -> Entry(-width=>6, -textvariable=>\$peak_params{width},
				      -validate=>'all',
				      -validatecommand=>[\&peak_set_variable, 'width'],
				     );
  $hlist->itemCreate(1, 8, -itemtype=>'window', -widget=>$widget{peak_width});
  $widget{peak_fit_w} = $hlist -> Checkbutton(-text=>"",
					      -selectcolor=>$config{colors}{single},
					      -variable=>\$peak_params{fit_w});
  $hlist->itemCreate(1, 9, -itemtype=>'window', -widget=>$widget{peak_fit_w});


  #my $normalbg=$top->ItemStyle('window', -background=>$config{colors}{background});
  #my $alternatebg=$top->ItemStyle('window', -background=>$config{colors}{background2});
  foreach my $i (1 .. $npeaks) {
    $hlist->add($i+1);

    $peak_params{"e$i"} = "";
    $peak_params{"a$i"} = $config{peakfit}{peakamp};
    $peak_params{"w$i"} = $config{peakfit}{peakwidth};
    $peak_params{"f$i"} = "none";
    $peak_params{"function$i"} = "none";
    $peak_params{"fit_e$i"} = 0;
    $peak_params{"fit_a$i"} = 1;
    $peak_params{"fit_w$i"} = 1;
    $peaks[$i] = 0;
    #my $bg  = ($i % 2) ? $config{colors}{background2} : $config{colors}{background};
    #my $abg = ($i % 2) ? $config{colors}{activebackground2} :
    my $bg  = $config{colors}{background};
    my $abg = $config{colors}{activebackground};
    #my $style = ($i % 2) ? $alternatebg : $normalbg;
    push @param_list, "e$i", "a$i", "w$i";
    $widget{"peak_function$i"} = $hlist ->
      Optionmenu(-textvariable => \$peak_params{"function$i"}, -width=>5,
		 -borderwidth=>1, -background=>$bg, -activebackground=>$abg);
    foreach my $f (qw(none gauss loren pvoight atan erf CL)) {
      $widget{"peak_function$i"} ->
	command(-label => $f, -state=>($f =~ /(pvoight|CL)/) ? 'disabled' : 'normal',
		-command=>sub{
		  $peak_params{"function$i"} = $f;
		  $peaks[$i] = ($f eq 'none') ? 0 : 1;
		SWITCH: {
		    $peak_params{"f$i"} = 'none',    last SWITCH if ($f eq 'none');
		    $peak_params{"f$i"} = 'gauss',   last SWITCH if ($f eq 'gauss');
		    $peak_params{"f$i"} = 'loren',   last SWITCH if ($f eq 'loren');
		    $peak_params{"f$i"} = 'pvoight', last SWITCH if ($f eq 'pvoight');
		    $peak_params{"f$i"} = 'atan',    last SWITCH if ($f eq 'atan');
		    $peak_params{"f$i"} = 'erf',     last SWITCH if ($f eq 'erf');
		    $peak_params{"f$i"} = 'CL',      last SWITCH if ($f eq 'CL');
		  };
		  foreach my $p (qw(e a w)) {
		    $peak_params{$p.$i} = $widget{"peak_$p$i"}->get();
		  };
		  #&peak_do_fit($current, \%peak_params, $peak_results, @peaks);
		});
    };
    $hlist->itemCreate($i+1, 0, -itemtype=>'window', -widget=>$widget{"peak_function$i"});
    $widget{"peak_e$i"} = $hlist -> Entry(-width=>8, -textvariable=>\$peak_params{"e$i"},
					 -background=>$bg, -validate=>'all',
					 -validatecommand=>[\&peak_set_variable, "e$i"],
					);
    $hlist->itemCreate($i+1, 1, -itemtype=>'window',
		       -widget=>$widget{"peak_e$i"});
    my $inner =  $hlist -> Frame();
    $hlist->itemCreate($i+1, 2, -itemtype=>'window', -widget=>$inner);
    $grab{"peak_e$i"} = $inner -> Button(@pluck_button, @pluck,
					 -background=>$bg , -activebackground=>$abg,
					 -command=>sub{&pluck("peak_e$i")}) -> pack();
    #$hlist->itemCreate($i+1, 2, -itemtype=>'window', -widget=>$grab{"peak_e$i"});
    $widget{"peak_fit_e$i"} = $hlist -> Checkbutton(-text=>"",
						    -background=>$bg,
						    -activebackground=>$abg,
						    -selectcolor=>$config{colors}{single},
						    -variable=>\$peak_params{"fit_e$i"});
    $hlist->itemCreate($i+1, 3, -itemtype=>'window', -widget=>$widget{"peak_fit_e$i"});
    $widget{"peak_a$i"} = $hlist -> Entry(-width=>6, -textvariable=>\$peak_params{"a$i"},
					  -background=>$bg, -validate=>'all',
					  -validatecommand=>[\&peak_set_variable, "a$i"],
				       );
    $hlist->itemCreate($i+1, 5, -itemtype=>'window', -widget=>$widget{"peak_a$i"});
    $widget{"peak_fit_a$i"} = $hlist -> Checkbutton(-text=>"",
						    -background=>$bg,
						    -activebackground=>$abg,
						    -selectcolor=>$config{colors}{single},
						    -variable=>\$peak_params{"fit_a$i"});
    $hlist->itemCreate($i+1, 6, -itemtype=>'window', -widget=>$widget{"peak_fit_a$i"});
    $widget{"peak_w$i"} = $hlist -> Entry(-width=>6, -textvariable=>\$peak_params{"w$i"},
					  -background=>$bg, -validate=>'all',
					  -validatecommand=>[\&peak_set_variable, "w$i"],
					 );
    $hlist->itemCreate($i+1, 8, -itemtype=>'window', -widget=>$widget{"peak_w$i"});
    $widget{"peak_fit_w$i"} = $hlist -> Checkbutton(-text=>"",
						    -background=>$bg,
						    -activebackground=>$abg,
						    -selectcolor=>$config{colors}{single},
						    -variable=>\$peak_params{"fit_w$i"});
    $hlist->itemCreate($i+1, 9, -itemtype=>'window', -widget=>$widget{"peak_fit_w$i"});

  };

  $frame = $peak -> Frame()
    -> pack(-side=>'bottom', -fill=>'x');
  $widget{peak_save} = $frame ->
    Button(-text=>'Save fit as a data group',  @button_list,
	   -width=>1,
	   -state=>'disabled',
	   -command=>sub{
	     my $group = $groups{$current}->{group};
	     my $name  = $groups{$current}->{label};
	     my ($new, $label) = group_name("Peak $name");
	     $groups{$new} = Ifeffit::Group -> new(group=>$new, label=>$label);
	     ##$groups{$new} -> set_to_another($groups{$group});
	     $groups{$new} -> make(is_xmu => 0, is_chi => 0, is_rsp => 0,
				   is_qsp => 0, is_bkg => 0,
				   not_data => 1);
	     $groups{$new} -> make(bkg_e0 => $groups{$group}->{bkg_e0});
	     $groups{$new}->{titles} = [];
	     my $text = $peak_results -> get(qw(1.0 end));
	     ## see refresh_titles for explanation
	     foreach (split(/\n/, $text)) {
	       next if ($_ =~ /^\s*$/);
	       my $count = 0;
	       foreach my $i (0..length($_)) {
		 ++$count if (substr($_, $i, 1) eq '(');
		 --$count if ($count and (substr($_, $i, 1) eq ')'));
	       };
	       $_ .= ')' x $count;
	       push @{$groups{$new}->{titles}}, $_;
	     };
	     $groups{$new} -> put_titles;
	     my $sets = "set($new.energy = $group.energy + " . $groups{$group}->{bkg_eshift} . ",\n";
	     $sets   .= "    $new.det = p___eak.fun)";
	     $groups{$new}->dispose($sets, $dmode);
	     ++$line_count;
	     fill_skinny($list, $new, 1);
	     my $memory_ok = $groups{$new}
	       -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
	     Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
	   }
	  )
      -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $widget{peak_log} = $frame ->
    Button(-text=>'Write a log file',  @button_list,
	   -width=>1,
	   -state=>'disabled',
	   -command=>sub{&peak_log($current, $peak_results, \%peak_params, @peaks)}, )
      -> pack(-side=>'right', -expand=>1, -fill=>'x');


  $frame = $peak -> Frame()
    -> pack(-side=>'bottom', -fill=>'x');
  $widget{peak_reset} =
  $frame -> Button(-text=>'Reset amplitudes and widths',  @button_list,
		   -width=>1,
		   -command=>sub{
		     $widget{"peak_amp"}   -> delete(qw(0 end));
		     $widget{"peak_amp"}   -> insert(0, 1.0);
		     $widget{"peak_width"} -> delete(qw(0 end));
		     $widget{"peak_width"} -> insert(0, 1.0);
		     foreach my $i (1 .. $#peaks) {
		       $widget{"peak_a$i"} -> delete(qw(0 end));
		       $widget{"peak_a$i"} -> insert(0, $config{peakfit}{peakamp});
		       $widget{"peak_w$i"} -> delete(qw(0 end));
		       $widget{"peak_w$i"} -> insert(0, $config{peakfit}{peakwidth});
		     };
		   })
    -> pack(-side=>'right', -expand=>1, -fill=>'x');
  $widget{peak_plot} =
  $frame -> Button(-text=>'Plot lineshapes',  @button_list,
		   -width=>1,
		   -command=>sub{
		     Error("This is not mu(E) data."), return unless $groups{$current}->{is_xmu};
		     my $fun = $ {$widget{peak_function}->cget("-textvariable")};
		     $peak_params{function} = $fun;
		     foreach my $p (qw(enot amp width)) {
		       $peak_params{$p} = $widget{"peak_$p"}->get();
		     };
		     foreach my $i (1 .. $#peaks) {
		       my $fun = $ {$widget{"peak_function$i"}->cget("-textvariable")};
		       $peaks[$i] = (lc($fun) eq 'none') ? 0 : 1;
		       $peak_params{"f$i"} = $fun;
		       foreach my $p (qw(e a w)) {
			 $peak_params{$p.$i} = $widget{"peak_$p$i"}->get();
		       };
		     };
		     &peak_do_fit($current, 0, \%peak_params, $peak_results, @peaks);
		     $widget{peak_save} -> configure(-state=>'normal');
		     $widget{peak_log}  -> configure(-state=>'normal');
		   })
    -> pack(-side=>'left', -expand=>1, -fill=>'x');

  $peak -> Button(-text=>'Fit lineshapes',  @button_list,
		   -command=>sub{
		     Error("This is not mu(E) data."), return unless $groups{$current}->{is_xmu};
		     my $fun = $ {$widget{peak_function}->cget("-textvariable")};
		     $peak_params{function} = $fun;
		     foreach my $p (qw(enot amp width)) {
		       $peak_params{$p} = $widget{"peak_$p"}->get();
		     };
		     foreach my $i (1 .. $#peaks) {
		       my $fun = $ {$widget{"peak_function$i"}->cget("-textvariable")};
		       $peaks[$i] = (lc($fun) eq 'none') ? 0 : 1;
		       $peak_params{"f$i"} = $fun;
		       foreach my $p (qw(e a w)) {
			 $peak_params{$p.$i} = $widget{"peak_$p$i"}->get();
		       };
		     };
		     &peak_do_fit($current, 1, \%peak_params, $peak_results, @peaks);
		     $widget{peak_save} -> configure(-state=>'normal');
		     $widget{peak_log}  -> configure(-state=>'normal');
		   })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);




  ## text box containing the results + buttons for log file and data group
  $nc{results} = $nb -> add('results', -label=>'Results', -anchor=>'center',);
  $peak_results = $nc{results} -> Scrolled('ROText', qw(-relief sunken -borderwidth 2
							-wrap none -scrollbars se
							-width 5 -height 5),
					   -font=>$config{fonts}{fixed})
    -> pack(qw/-expand yes -fill both -side top/);
  disable_mouse3($peak_results->Subwidget('rotext'));
  $peak_results -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background});
  $peak_results -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background});
  $peak_results -> tagConfigure("text", -font=>$config{fonts}{fixedsm});


  $groups{$current}->{update_bkg} and $groups{$current}->dispatch_bkg($dmode);
  $groups{$current}->{peak} and peak_fill_variables($current, \%peak_params, \@peaks);
  &peak_do_fit($current, 1, \%peak_params, $peak_results, @peaks);
  #$peak -> grab;
  $plotsel -> raise('e');
  $top -> update;

};


sub peak_do_fit {
  my ($standard, $do_fit, $r_params, $peak_results, @peaks) = @_;

  Error("Peak fit aborted: " . $groups{$standard}->{label} . " is not an xmu group."),
    return unless ($groups{$standard}->{is_xmu});

  Echo("Fitting near edge peak structure for \`$groups{$standard}->{label}\' ... ");
  $top -> Busy(-recurse=>1,);
  my $emin += $$r_params{emin} + $$r_params{enot};
  my $emax += $$r_params{emax} + $$r_params{enot};
  my $offset = "";
 SWITCH: {
    $offset = "/pi + 0.5", last SWITCH if ($$r_params{function} eq 'atan');
    $offset = " + 1",      last SWITCH if ($$r_params{function} eq 'erf');
  };
  my @deltas = ();
  my @deflist = ();
  my $command = "## starting peak fit for " . $groups{$standard}->{label} . "\n";
  $command   .= "unguess\nerase \@group p___eak\n";
  $command   .= "set $standard.eshift = $standard.energy + " .
    $groups{$standard}->{bkg_eshift} . "\n";
  $groups{$standard} ->dispose("## clean up parameters from previous fit...", $dmode) if $$r_params{deltas};
  foreach my $d (@{$$r_params{deltas}}) {
    $groups{$standard} ->dispose("erase $d delta_$d\n", $dmode);
  };
  my $function = "p___eak.fun  = 0";
  ## $ymax is used for the vertical lines marking the fit range
  my $suff = ($groups{$standard}->{bkg_flatten}) ? 'flat' : 'norm';
  $groups{$standard} ->
    dispose("set ___x = splint($standard.energy+$groups{$standard}->{bkg_eshift}, $standard.$suff, $$r_params{enot})", 1);
  my $ymax = 2.5*Ifeffit::get_scalar("___x");
  $$r_params{ymax} = $ymax;

  ## save peak fitting parameters in data group
  $groups{$standard} -> MAKE(peak=>1,
			     peak_enot=>$$r_params{enot},
			     peak_amp=>$$r_params{amp},
			     peak_width=>$$r_params{width},
			     peak_function=>$$r_params{function},
			     peak_function_choice=>$$r_params{function_choice},
			     peak_fit_e=>$$r_params{fit_e},
			     peak_fit_a=>$$r_params{fit_a},
			     peak_fit_w=>$$r_params{fit_w},
			    );
  unless ($$r_params{function} eq 'none') {
    my ($fite, $fita, $fitw);
    #($fita, $toss, $fitw, $toss) = split(" ", $$r_params{fit_choice});
    $fite = ($$r_params{fit_e}) ? "guess" : "set  ";
    $fita = ($$r_params{fit_a}) ? "guess" : "set  ";
    $fitw = ($$r_params{fit_w}) ? "guess" : "set  ";
    $command .= "$fite p___eak_e = $$r_params{enot}\n";
    $command .= "$fita p___eak_amp = $$r_params{amp}\n";
    $command .= "$fitw p___eak_width = $$r_params{width}\n";
    $command .= "def p___eak.step = p___eak_amp * ($$r_params{function}(($standard.eshift - p___eak_e)/p___eak_width)$offset)\n";
    $function = "def p___eak.fun  = p___eak.step";
    push @deltas, qw(p___eak_e p___eak_amp p___eak_width);
    push @deflist, "p___eak.step", "p___eak.fun";
  };
  ## build the peak arrays, taking care not to leave any unused
  ## variables lying around
  foreach my $ipk (0 .. $#peaks) {
    my $i = $ipk+1;
    my $this = $$r_params{"f$i"};
    next unless ($peaks[$i] and ($$r_params{"e$i"}));
    my ($fite, $fita, $fitw, $toss);
    #($fita, $toss, $fitw, $toss) = split(" ", $$r_params{"fit$i"});
    $fite = ($$r_params{"fit_e$i"}) ? "guess" : "set  ";
    $fita = ($$r_params{"fit_a$i"}) ? "guess" : "set  ";
    $fitw = ($$r_params{"fit_w$i"}) ? "guess" : "set  ";
    $command .= "$fite p___eak_e$i = " . $$r_params{"e$i"} . "\n";
    $command .= "$fita p___eak_a$i = " . $$r_params{"a$i"} . "\n";
    $command .= "$fitw p___eak_w$i = " . $$r_params{"w$i"} . "\n";
    push @deltas, "p___eak_e$i",  "p___eak_a$i",  "p___eak_w$i";
    if ($this =~ /(gauss|loren|pvoight)/) { # peak function
      $command .= "def p___eak.peak$i = p___eak_a$i * $this($standard.eshift, p___eak_e$i, p___eak_w$i)\n";
    } else {			# extra step function
      my $ff = $$r_params{"f$i"};
      my $offset = "";
    SWITCH: {
	$offset = "/pi + 0.5", last SWITCH if ($ff eq 'atan');
	$offset = " + 1",      last SWITCH if ($ff eq 'erf');
      };
      $command .= "def p___eak.peak$i = p___eak_a$i * ($ff(($standard.eshift - p___eak_e$i)/p___eak_w$i)$offset)\n";
    };
    ## add this peak to the fitting function
    $function .= " + p___eak.peak$i";
    push @deflist, "p___eak.peak$i";
    ## save peak parameters to the data group
    $groups{$standard} -> MAKE("peak_e$i"=>$$r_params{"e$i"}, "peak_a$i"=>$$r_params{"a$i"},
			       "peak_w$i"=>$$r_params{"w$i"}, "peak_f$i"=>$$r_params{"f$i"},
			       "peak_function$i"=>$$r_params{"function$i"},
			       "peak_fit$i"=>$$r_params{"fit$i"},
			      );
  };

  ## make the residual array and then minimize
  $command .= $function . "\n";
  if ($do_fit) {
    $command .= "def p___eak.resid = $standard.$suff - p___eak.fun\n";
    $command .= "minimize(p___eak.resid, x=$standard.eshift, xmin=$emin, xmax=$emax)\n";
    push @deflist, "p___eak.resid";
  };
  $groups{$standard} -> dispose($command, $dmode);
  $$r_params{deltas} = \@deltas;
  $groups{$standard} -> dispose("## don't want to leave defs lying around...\n", $dmode);
  foreach my $f (@deflist) {
    $groups{$standard} -> dispose("set($f = $f)\n", $dmode);
  };

  ## store the results of the fit
  foreach my $p (qw(amp width)) {
    $widget{"peak_$p"} -> delete(qw(0 end));
    $$r_params{$p} = sprintf("%.3f", Ifeffit::get_scalar("p___eak_$p"));
    $widget{"peak_$p"} -> insert(0, $$r_params{$p});
  };
  foreach my $ipk (0 .. $#peaks) {
    my $i = $ipk+1;
    next unless ($peaks[$i] and ($$r_params{"e$i"}));
    foreach my $p (qw(e a w)) {
      $widget{"peak_$p$i"} -> delete(qw(0 end));
      $$r_params{"$p$i"} = sprintf("%.3f", Ifeffit::get_scalar("p___eak_$p$i"));
      $widget{"peak_$p$i"} -> insert(0, $$r_params{"$p$i"});
    };
  };
  ## plot the result
  $groups{$standard}->plotE('emn', $dmode, \%plot_features, \@indicator);
  my $fitcolor  = $config{plot}{c1};
  $groups{$standard}->dispose("plot($standard.eshift, p___eak.fun, key=fit, color=$fitcolor, style=lines)", $dmode);
  my $ic = 2;
  if ($$r_params{plot_components}) {
    unless ($widget{peak_function} eq 'None') {
      my $color = $config{plot}{c2};
      $groups{$standard}->dispose("plot($standard.eshift, p___eak.step, key=\"step\", style=lines, color=$color)", $dmode);
    };
    foreach my $ipk (0 .. $#peaks) {
      my $i  = $ipk+1;
      next unless ($peaks[$i] and ($$r_params{"e$i"}));
      ++$ic;
      my $color = $config{plot}{'c'.$ic};
      $groups{$standard}->dispose("plot($standard.eshift, p___eak.peak$i, key=\"peak $i\", style=lines, color=$color)", $dmode);
    };
  };
  if ($$r_params{plot_difference}) {
    ++$ic;
    my @e = Ifeffit::get_array("$standard.eshift");
    my @x = Ifeffit::get_array('p___eak.resid');
    my ($emin, $emax) = ($$r_params{enot}+$$r_params{emin},$$r_params{enot}+$$r_params{emax});
    foreach my $i (0 .. $#e) {
      ($x[$i] = 0) if (($e[$i] < $emin) or ($e[$i] > $emax));
    };
    Ifeffit::put_array('p___eak.diff', \@x);
    my $color = $config{plot}{'c'.$ic};
    $groups{$standard}->dispose("plot($standard.eshift, p___eak.diff, key=\"difference\", style=lines, color=$color)", $dmode);
  };
  $groups{$standard}->plot_vertical_line($emin, 0, $ymax, $dmode, "fit range",
					 $groups{$standard}->{plot_yoffset});
  $groups{$standard}->plot_vertical_line($emax, 0, $ymax, $dmode, "",
					 $groups{$standard}->{plot_yoffset});
  $$r_params{mark_centroids} and peak_mark_centroids($standard,$r_params,\@peaks);
  $last_plot='e';
  peak_fill_results($standard, $r_params, $peak_results, @peaks) if ($do_fit);
  $$r_params{peaks} = \@peaks;
  $top->Unbusy;
  Echo("Fitting near edge peak structure for \`$groups{$standard}->{label}\' ... done!");
};


sub peak_fill_results {
  my ($standard, $r_params, $peak_results, @peaks) = @_;
  $peak_results -> delete(qw(1.0 end));
  $peak_results -> insert('end', "Results of near edge peak fit to \"$groups{$standard}->{label}\"\n\n", 'text');
  $peak_results -> insert('end', "Fitting range = \[$$r_params{emin}:$$r_params{emax}\] (relative to centroid of step function)\n\n", 'text');

  my $suff = ($groups{$standard}->{bkg_flatten}) ? 'flat' : 'norm';
  my @e = Ifeffit::get_array("$standard.eshift");
  my @r = Ifeffit::get_array('p___eak.resid');
  my @x = Ifeffit::get_array("$standard.$suff");
  my ($emin, $emax) = ($$r_params{enot}+$$r_params{emin},$$r_params{enot}+$$r_params{emax});
  my ($rfactor, $sumsqr, $npts) = (0, 0, 0);
  foreach my $i (0 .. $#e) {
    if (($e[$i] > $emin) and ($e[$i] < $emax)) {
      ++$npts;
      $rfactor += $r[$i]**2;
      $sumsqr  += $x[$i]**2;
    };
  };
  my $chisqr = Ifeffit::get_scalar("chi_square");
  my $chinu  = Ifeffit::get_scalar("chi_reduced");
  my $nvarys = Ifeffit::get_scalar("n_varys");
  $peak_results -> insert('end', "Fit included $npts data points and $nvarys variables\n");
  $peak_results -> insert('end', sprintf("R-factor = %.5f, chi-square = %.5f, reduced chi-square = %.7f\n\n",
					 $rfactor/$sumsqr, $chisqr, $chinu), 'text');

  if ($$r_params{function} eq 'none') {
    $peak_results -> insert('end', "No step function was used\n", 'text');
    $peak_results -> insert('end', " function       centroid             amplitude        width\n", 'text');
  } else {
    $peak_results -> insert('end', " function       centroid             amplitude        width\n", 'text');
    $peak_results -> insert('end',
			    sprintf(" %-14s %8.2f(%8.2f) %6.3f(%6.3f) %6.3f(%6.3f)\n",
				    $$r_params{function_choice},
				    $$r_params{enot},  Ifeffit::get_scalar("delta_p___eak_e"),
				    $$r_params{amp},   Ifeffit::get_scalar("delta_p___eak_amp"),
				    $$r_params{width}, Ifeffit::get_scalar("delta_p___eak_width")),
			    'text');
  };
  foreach  my $ipk (0 .. $#peaks) {
    my $i = $ipk+1;
    next unless ($peaks[$i] and ($$r_params{"e$i"}));
    $peak_results -> insert('end',
			    sprintf(" %-14s %8.2f(%8.2f) %6.3f(%6.3f) %6.3f(%6.3f)\n",
				    $$r_params{"function$i"},
				    $$r_params{"e$i"}, Ifeffit::get_scalar("delta_p___eak_e$i"),
				    $$r_params{"a$i"}, Ifeffit::get_scalar("delta_p___eak_a$i"),
				    $$r_params{"w$i"}, Ifeffit::get_scalar("delta_p___eak_w$i")),
			    'text');
  };
  $peak_results -> insert('end', "\n\nThe Gaussians and Lorentzians are unit normalized,\nso the amplitudes are the areas.", 'text');
};


sub peak_fill_variables {
  my ($standard, $r_params, $r_peaks) = @_;
  $$r_params{enot}	  = $groups{$standard}->{peak_enot};
  $$r_params{amp}	  = $groups{$standard}->{peak_amp};
  $$r_params{width}	  = $groups{$standard}->{peak_width};
  $$r_params{function}	  = $groups{$standard}->{peak_function};
  $$r_params{function_choice} = $groups{$standard}->{peak_function_choice};
  $$r_params{fit_e}       = $groups{$standard}->{peak_fit_e}||0;
  $$r_params{fit_a}       = $groups{$standard}->{peak_fit_a}||1;
  $$r_params{fit_w}       = $groups{$standard}->{peak_fit_w}||1;

  ## yipes!  this counts the size of the dereferenced array
  foreach my $ipk (0 .. $#{@$r_peaks}) {
    my $i = $ipk+1;
    next unless ($groups{$standard}->{"peak_e$i"});
    $$r_params{"e$i"}	     = $groups{$standard}->{"peak_e$i"};
    $$r_params{"a$i"}	     = $groups{$standard}->{"peak_a$i"} || 0.3;
    $$r_params{"w$i"}	     = $groups{$standard}->{"peak_w$i"} || 1.0;
    $$r_params{"f$i"}	     = $groups{$standard}->{"peak_f$i"} || 'none';
    $$r_params{"function$i"} = $groups{$standard}->{"peak_function$i"} || 'none';
    $$r_params{"fit_e$i"}    = $groups{$standard}->{"peak_fit_e$i"};
    $$r_params{"fit_a$i"}    = $groups{$standard}->{"peak_fit_a$i"};
    $$r_params{"fit_w$i"}    = $groups{$standard}->{"peak_fit_w$i"};
    ($$r_params{"e$i"} and ($$r_params{"function$i"} ne 'none')) and ($$r_peaks[$i] = 1);
  };
};

sub peak_set_variable {
  my ($k, $entry, $prop) = (shift, shift, shift);
  ($entry =~ /^\s*$/) and ($entry = 0);	# error checking ...
  ($entry =~ /^\s*-$/) and return 1;	# error checking ...
  ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
};


sub peak_log {
  my ($standard, $peak_results, $r_params, @peaks) = @_;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [['Log files', '.log'], ['All files', '*']];
  my $initial = $groups{$standard}->{label}."_peak.log";
  ($initial =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  my $file = $top ->
    getSaveFile(-filetypes=>$types,
		#(not $is_windows) ?
		#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
		-initialdir=>$path,
		-initialfile=>$initial,
		-title => "Athena: Save peak fit log file");
  return unless $file;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  #&push_mru($file, 0);
  Echo("Saving log file from peak fit to \"$standard\" ...");

  my $command = q{};
  my $i = 0;
  foreach my $line (split(/\n/, $peak_results->get(qw(1.0 end)))) {
    ++$i;
    if ($line) {
      $command .= "set \$peak_title_$i = \"$line\"\n";
    } else {
      $command .= "set \$peak_title_$i = \".   \"\n";
    };
    if ($line =~ /^Results/) {
      ++$i;
      $command .= "set \$peak_title_$i = \"Titles from $groups{$standard}->{label}\"\n";
      foreach (@{$groups{$standard}->{titles}}) {
	++$i;
	$command .= "set \$peak_title_$i = \"  .  $_\"\n";
      };
    } elsif ($line =~ /^\s*function/) {
      ++$i;
      $command .= "set \$peak_title_$i = \"" . "=" x 60 . "\"\n";
    };
  };


  ++$i;
  $command .= "set \$peak_title_$i = \"Formulas:\"\n";
  ++$i;
  $command .= "set \$peak_title_$i = \"-  arctangent:       A*[atan((e-E0)/W)/pi + 0.5]\"\n";
  ++$i;
  $command .= "set \$peak_title_$i = \"-  error function:   A*[erf((e-E0)/W) + 1]\"\n";
  ++$i;
  $command .= "set \$peak_title_$i = \"-  Gaussian:         [A/(W*sqrt(2pi))] * exp[-(e-E0)^2/(2W^2)]\"\n";
  ++$i;
  $command .= "set \$peak_title_$i = \"-  Lorentzian:       (AW/2pi) / [(e-E0)^2 + (W/2)^2]\"\n";

  $command .= sprintf("set %s.ee = %s.energy + %f\n", $standard, $standard, $groups{$standard}->{bkg_eshift});

  my $peakstring = q{};
  my $ic = 0;
  foreach my $ipk (0 .. $#peaks) {
    my $i  = $ipk+1;
    next unless ($peaks[$i] and ($$r_params{"e$i"}));
    ++$ic;
    $peakstring .= ", p___eak.peak$ic";
  };
  my $suff = ($groups{$standard}->{bkg_flaten}) ? 'flat' : 'norm';
  $command .= "write_data(file=\"$file\", \$peak_title_\*, $standard.ee, $standard.$suff, p___eak.fun, p___eak.step$peakstring, p___eak.resid)\n";

  $groups{$standard}->dispose($command, $dmode);

  my $postcmd = q{};
  foreach my $j (1 .. $i) {
    $postcmd .= "erase \$peak_title_$j\n";
  };
  $groups{$standard}->dispose($postcmd, $dmode);

  Echo("Saving log file from peak fit to \"$groups{$standard}->{label}\" ... done!");
}


sub peak_mark_centroids {
  my ($standard, $r_params, $r_peaks) = @_;
  $$r_params{toplevel} -> Busy(-recurse=>1);
  my @list;
  push @list, $$r_params{enot} unless ($$r_params{function_choice} eq 'none');
  foreach my $ipk (0 .. $#{@$r_peaks}) {
    my $i = $ipk+1;
    push @list, $$r_params{"e$i"} if $$r_params{"e$i"};
  };

  my $string = "$config{plot}{marker}, $config{plot}{markercolor}, $groups{$standard}->{plot_yoffset}";
  my $command = "";
  foreach my $e (@list) {
    $command .= "pmarker \"$standard.energy+$groups{$standard}->{bkg_eshift}\", " .
      "p___eak.fun, $e, $string\n";
  };
  $groups{$standard} -> dispose($command, $dmode);
  $$r_params{toplevel} -> Unbusy
};




## END OF PEAK FITTING SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2009 Bruce Ravel
##
##  This file implements linear combination XANES fitting in Athena

sub lcf {

  ## generally, we do not change modes unless there is data.
  ## exceptions include things like the prefernces and key bindings,
  ## which are data-independent
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");

  ## this is a way of testing the current list of data groups for some
  ## necessary property.  for the demo, this will just be the list of
  ## groups
  my @keys = ('None');
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu} or $groups{$k}->{is_chi}) and push @keys, $k;
  };
  Echo("You need two or more xmu groups to do linear combination fitting"), return unless ($#keys >= 2);

  $values_menubutton -> menu -> entryconfigure(17, -state=>'disabled'); # purge lcf
  $right_values -> menu -> entryconfigure(17, -state=>'disabled'); # purge lcf
  my %lcf_params = (unknown    => $current,
		    fitspace   => $groups{$current}->{lcf_fitspace} || $config{linearcombo}{fitspace},
		    components => $config{linearcombo}{components},
		    difference => 0,
		    fitmin_e   => $groups{$current}->{lcf_fitmin_e} || $config{linearcombo}{fitmin},
		    fitmax_e   => $groups{$current}->{lcf_fitmax_e} || $config{linearcombo}{fitmax},
		    fitmin_k   => $groups{$current}->{lcf_fitmin_k} || $config{linearcombo}{fitmin_k},
		    fitmax_k   => $groups{$current}->{lcf_fitmax_k} || $config{linearcombo}{fitmax_k},
		    enot       => $groups{$current}->{bkg_e0},
		    linear     => $groups{$current}->{lcf_linear} || 0,
		    nonneg     => $groups{$current}->{lcf_nonneg} || 1,
		    100        => $groups{$current}->{lcf_100}    || 1,
		    e0all      => $groups{$current}->{lcf_e0all}  || 0,
		    yint       => 0,
		    slope      => 0,
		    noise      => 0,
		    deflist    => [],
		    toggle     => 0,
		    maxstan    => 4,
		    iterator   => "",
		    sumsqr     => 0,
		    kw         => $plot_features{kw} || 1,
		    #kw         => $groups{$current}->{fft_kw} || 1,
		    keys       => \@keys,
		    );
  if ($lcf_params{fitspace} eq 'k') {
    $lcf_params{fitmin} = $lcf_params{fitmin_k};
    $lcf_params{fitmax} = $lcf_params{fitmax_k};
  } else {
    $lcf_params{fitmin} = $lcf_params{fitmin_e};
    $lcf_params{fitmax} = $lcf_params{fitmax_e};
  };
  ($lcf_params{fitspace} = 'k') if $groups{$current}->{is_chi};

  my $ps = $project_saved;
  my @save = ($plot_features{emin}, $plot_features{emax});
  $plot_features{emin} = $config{linearcombo}{emin};
  $plot_features{emax} = $config{linearcombo}{emax};
  project_state($ps);		# don't toggle if currently saved

  ## these two global variables must be set before this view is displayed
  $fat_showing = 'lcf';
  $hash_pointer = \%lcf_params;

  ## disable many menus.
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $lcf = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$lcf -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $lcf;

  $lcf -> Label(-text=>"Linear combination fitting",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  my $frame = $lcf -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x');
  $frame -> Label(-text=>"Unknown: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		  )
    -> pack(-side=>'left');

  $widget{lcf_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					 -foreground=>$config{colors}{button})
    -> pack(-side=>'left');


  $frame = $lcf -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x',);
  $frame -> Label(-text=>"Fitting range: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		  )
    -> pack(-side=>'left', -anchor=>'n');
  $widget{lcf_fitmin} = $frame -> Entry(-width=>6,
					-validate=>'none',
					-validatecommand=>[\&lcf_set_variable, 'lcf_fitmin'],
					##-textvariable=>\$lcf_params{fitmin},
				       )
    -> pack(-side=>'left', -anchor=>'n');
  $grab{lcf_fitmin} = $frame -> Button(@pluck_button, @pluck,
				       -command=>sub{lcf_pluck(\%lcf_params, 'fitmin');
						     lcf_quickplot(\%lcf_params); })
    -> pack(-side=>'left', -pady=>2, -anchor=>'n');
  $frame -> Label(-text=>' to ',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left', -anchor=>'n');
  $widget{lcf_fitmax} = $frame -> Entry(-width=>6,
					-validate=>'none',
					-validatecommand=>[\&lcf_set_variable, 'lcf_fitmax'],
					##-textvariable=>\$lcf_params{fitmax},
				       )
    -> pack(-side=>'left', -anchor=>'n');
  $grab{lcf_fitmax} = $frame -> Button(@pluck_button, @pluck,
				       -command=>sub{lcf_pluck(\%lcf_params, 'fitmax');
						     lcf_quickplot(\%lcf_params); })
    -> pack(-side=>'left', -pady=>2, -anchor=>'n');
  $widget{lcf_components} = $frame
    -> Checkbutton(-text=>'Plot components?',
		   -selectcolor=>$config{colors}{single},
		   -width=>15,
		   -anchor=>'w',
		   -variable=>\$lcf_params{components})
      -> pack(-side=>'right', -anchor=>'w');

  $frame = $lcf -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x');
  $frame -> Label(-text=>"Fitting space: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		  )
    -> pack(-side=>'left', -anchor=>'n');
  $frame -> Radiobutton(-text=>'norm(E)',
			-selectcolor=>$config{colors}{single},
			-value=>'e',
			-variable=>\$lcf_params{fitspace},
			-command=>sub{
			  $lcf_params{fitmin_e} = $groups{$current}->{lcf_fitmin_e} || $config{linearcombo}{fitmin};
			  $lcf_params{fitmax_e} = $groups{$current}->{lcf_fitmax_e} || $config{linearcombo}{fitmax};
			  $groups{$current}->MAKE(lcf_fitspace => $lcf_params{fitspace},
						  lcf_fitmin   => $lcf_params{fitmin_e},
						  lcf_fitmax   => $lcf_params{fitmax_e});
			  foreach (qw(fitmin fitmax)) {
			    $lcf_params{$_} = $lcf_params{$_."_e"};
			    $widget{"lcf_$_"} -> configure(-validate=>'none');
			    $widget{"lcf_$_"} -> delete(0, 'end');
			    $widget{"lcf_$_"} -> insert('end', $lcf_params{$_});
			    $widget{"lcf_$_"} -> configure(-validate=>'key');
			  };
			  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
			    $widget{"lcf_e0val$i"} -> configure(-state=>'normal');
			    $widget{"lcf_e0$i"} -> configure(-state=>'normal');
			  };
			  $widget{lcf_linear} -> configure(-state=>'normal');
			  $widget{lcf_e0all}  -> configure(-state=>'normal');
			  $widget{lcf_operations} -> entryconfigure(7, -state=>'disabled', -style=>$lcf_params{disabled_style});
			  lcf_reset(\%lcf_params,1);
			  lcf_quickplot_e(\%lcf_params);
			})
    -> pack(-side=>'left', -anchor=>'n');
  $frame -> Radiobutton(-text=>'deriv(E)',
			-selectcolor=>$config{colors}{single},
			-value=>'d',
			-variable=>\$lcf_params{fitspace},
			-command=>sub{
			  $lcf_params{fitmin_e} = $groups{$current}->{lcf_fitmin_e} || $config{linearcombo}{fitmin};
			  $lcf_params{fitmax_e} = $groups{$current}->{lcf_fitmax_e} || $config{linearcombo}{fitmax};
			  $groups{$current}->MAKE(lcf_fitspace => $lcf_params{fitspace},
						  lcf_fitmin   => $lcf_params{fitmin_e},
						  lcf_fitmax   => $lcf_params{fitmax_e});
			  foreach (qw(fitmin fitmax)) {
			    $lcf_params{$_} = $lcf_params{$_."_e"};
			    $widget{"lcf_$_"} -> configure(-validate=>'none');
			    $widget{"lcf_$_"} -> delete(0, 'end');
			    $widget{"lcf_$_"} -> insert('end', $lcf_params{$_});
			    $widget{"lcf_$_"} -> configure(-validate=>'key');
			  };
			  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
			    $widget{"lcf_e0val$i"} -> configure(-state=>'normal');
			    $widget{"lcf_e0$i"} -> configure(-state=>'normal');
			  };
			  $widget{lcf_linear} -> configure(-state=>'disabled');
			  $widget{lcf_e0all}  -> configure(-state=>'normal');
			  $widget{lcf_operations} -> entryconfigure(7, -state=>'disabled', -style=>$lcf_params{disabled_style});
			  lcf_reset(\%lcf_params,1);
			  lcf_quickplot_e(\%lcf_params);
			})
    -> pack(-side=>'left', -anchor=>'n');
  $frame -> Radiobutton(-text=>'chi(k)',
			-selectcolor=>$config{colors}{single},
			-value=>'k',
			-variable=>\$lcf_params{fitspace},
			-command=>sub{
			  $lcf_params{fitmin_k} = $groups{$current}->{lcf_fitmin_k} || $config{linearcombo}{fitmin_k};
			  $lcf_params{fitmax_k} = $groups{$current}->{lcf_fitmax_k} || $config{linearcombo}{fitmax_k};
			  $groups{$current}->MAKE(lcf_fitspace => $lcf_params{fitspace},
						  lcf_fitmin   => $lcf_params{fitmin_k},
						  lcf_fitmax   => $lcf_params{fitmax_k});
			  foreach (qw(fitmin fitmax)) {
			    $lcf_params{$_} = $lcf_params{$_."_k"};
			    $widget{"lcf_$_"} -> configure(-validate=>'none');
			    $widget{"lcf_$_"} -> delete(0, 'end');
			    $widget{"lcf_$_"} -> insert('end', $lcf_params{$_});
			    $widget{"lcf_$_"} -> configure(-validate=>'key');
			  };
			  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
			    $widget{"lcf_e0val$i"} -> configure(-state=>'disabled');
			    $widget{"lcf_e0$i"} -> configure(-state=>'disabled');
			  };
			  $widget{lcf_linear} -> configure(-state=>'disabled');
			  $widget{lcf_e0all}  -> configure(-state=>'disabled');
			  $widget{lcf_operations} -> entryconfigure(7, -state=>'normal', -style=>$lcf_params{normal_style});
			  lcf_reset(\%lcf_params,1);
			  lcf_quickplot_k(\%lcf_params);
			})
    -> pack(-side=>'left', -anchor=>'n');

  $widget{lcf_difference} = $frame
    -> Checkbutton(-text=>'Plot difference?',
		   -selectcolor=>$config{colors}{single},
		   -width=>15,
		   -anchor=>'w',
		   -variable=>\$lcf_params{difference})
      -> pack(-side=>'right', -anchor=>'w');





  ## this is a spacer frame which pushes all the widgets to the top
  ## $lcf -> Frame(-background=>$config{colors}{darkbackground})
  ##   -> pack(-side=>'bottom', -expand=>1, -fill=>'both');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $lcf -> Button(-text=>'Return to the main window',  @button_list,
		    -background=>$config{colors}{background2},
		    -activebackground=>$config{colors}{activebackground2},
		    -command=>sub{$groups{$current}->dispose("unguess\n", $dmode);
				  $values_menubutton -> menu -> entryconfigure(17, -state=>'normal'); # purge lcf
				  $right_values -> menu -> entryconfigure(17, -state=>'normal');
				  #$groups{$current}->dispose("erase \@group l___cf\n");
		                  &reset_window($lcf, "linear combination fitting", \@save);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $lcf -> Button(-text=>'Document section: Linear combination fitting',
		 @button_list,
		 -command=>sub{pod_display("analysis::lcf.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  my $notebook = $lcf ->NoteBook(-background=>$config{colors}{background},
				 -backpagecolor=>$config{colors}{background},
				 -inactivebackground=>$config{colors}{inactivebackground},
				 #-foreground=>$config{colors}{activehighlightcolor},
				 -font=>$config{fonts}{small},
				)
    -> pack(-side=>'top', -fill =>'both', -expand=>1, -padx=>4, -pady=>4);
  $widget{lcf_notebook} = $notebook;

  my ($buttonframe, $st, $re, $co);
  $st = $notebook -> add('standards',
			 -label=>'Standards spectra',
			 -anchor=>'center',
			 #-raisecmd=>sub{$buttonframe->pack(-in=>$st)}
			);
  $re = $notebook -> add('results',
			 -label=>'Fit results',
			 -anchor=>'center',
			 #-raisecmd=>sub{$buttonframe->pack(-in=>$re)}
			);
  $co = $notebook -> add('combinatorics',
			 -label=>'Combinatorics',
			 -anchor=>'center',
			 -state=>'disabled',
			 #-raisecmd=>sub{$buttonframe->packForget}
			);
  $widget{lcf_notebook} -> pageconfigure('combinatorics', -state=>'normal')
    if (exists $lcf_data{$current});


  my $outerframe = $st -> Frame()
    -> pack(-side=>'bottom', -fill=>'both', -expand=>1, -padx=>2, -pady=>0, -anchor=>'s');

  ## frame with control buttons
  $buttonframe = $outerframe -> LabFrame(-label=>'Operations',
					 -foreground=>$config{colors}{activehighlightcolor},
					 -labelside=>'acrosstop',)
    -> pack(-side=>'right', -fill=>'both', -expand=>1, -padx=>2, -pady=>4, -anchor=>'s');
  $widget{lcf_operations} = $buttonframe ->Scrolled('HList',
						    -scrollbars	      => 'oe',
						    -background	      => $config{colors}{background},
						    -selectmode	      => 'single',
						    -selectbackground => $config{colors}{activebackground},
						    -highlightcolor   => $config{colors}{background},
						    -browsecmd	      => sub{lcf_multiplexer(\%lcf_params)},
						   )
    -> pack(-fill=>'both', -expand=>1);
  $widget{lcf_operations} -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  BindMouseWheel($widget{lcf_operations});
  my $t = $buttonframe->Subwidget("label");
  my @bold   = (-foreground => $config{colors}{marked},);
  my @normal = (-foreground => $config{colors}{activehighlightcolor},);

  $t -> bind("<Any-Enter>", sub {shift->configure(@bold)});
  $t -> bind("<Any-Leave>", sub {shift->configure(@normal)});
  $t -> bind('<ButtonPress-1>' => sub{Echo("Clicking on an entries in the operations list will perform the function described.")});


  $lcf_params{normal_style}   = $widget{lcf_operations} -> ItemStyle('text',
								     -font=>$config{fonts}{small},
								     -anchor=>'w',
								     -foreground=>$config{colors}{foreground});
  $lcf_params{disabled_style} = $widget{lcf_operations} -> ItemStyle('text',
								     -font=>$config{fonts}{small},
								     -anchor=>'w',
								     -foreground=>$config{colors}{disabledforeground});


  $widget{lcf_operations} -> add(1,
				 -itemtype =>'text',
				 -text	   =>'Fit this group',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(2,
				 -itemtype =>'text',
				 -text	   =>'Fit all combinations',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(3,
				 -itemtype =>'text',
				 -text	   =>'Fit marked groups',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(4,
				 -itemtype =>'text',
				 -text	   =>'Write a report',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(5,
				 -itemtype =>'text',
				 -text	   =>'Marked fits report',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(6,
				 -itemtype =>'text',
				 -text	   =>'Plot data + sum',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(7,
				 -itemtype =>'text',
				 -text	   =>'Plot data + sum in R',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(8,
				 -itemtype =>'text',
				 -text	   =>'Make fit group',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(9,
				 -itemtype =>'text',
				 -text	   =>'Make difference group',
				 -state	   => 'disabled',
				 -style	   => $lcf_params{disabled_style},
				);
  $widget{lcf_operations} -> add(10,
				 -itemtype =>'text',
				 -text	   =>'Set params, all groups',
				 -state	   => 'normal',
				 -style	   => $lcf_params{normal_style},
				);
  $widget{lcf_operations} -> add(11,
				 -itemtype =>'text',
				 -text	   =>'Set params, marked groups',
				 -state	   => 'normal',
				 -style	   => $lcf_params{normal_style},
				);
  $widget{lcf_operations} -> add(12,
				 -itemtype =>'text',
				 -text	   =>'Reset',
				 -state	   => 'normal',
				 -style	   => $lcf_params{normal_style},
				);


  $frame = $buttonframe -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -padx=>0);




  ## frame with options
  $frame = $outerframe -> LabFrame(-label=>'Options',
				   -foreground=>$config{colors}{activehighlightcolor},
				   -labelside=>'acrosstop',)
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2, -pady=>4, -anchor=>'s');

  $widget{lcf_linear} = $frame -> Checkbutton(-text=>'Add a linear term after e0',
					      -selectcolor=>$config{colors}{single},
					      -variable=>\$lcf_params{linear})
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');
  $widget{lcf_nonneg} = $frame -> Checkbutton(-text=>'Weights between 0 & 1',
					      -selectcolor=>$config{colors}{single},
					      -variable=>\$lcf_params{nonneg})
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');

  $widget{lcf_100} = $frame -> Checkbutton(-text=>'Force weights to sum to 1',
					   -selectcolor=>$config{colors}{single},
					   -variable=>\$lcf_params{100})
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');
  $widget{lcf_e0all} = $frame -> Checkbutton(-text=>'All standards use same e0',
					     -selectcolor=>$config{colors}{single},
					     -variable=>\$lcf_params{e0all},
					     -command=>sub{
					       foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
						 if ($lcf_params{e0all}) {
						   $widget{"lcf_e0$i"} -> select;
						   $widget{"lcf_e0$i"} -> configure(-state=>'disabled');
						 } else {
						   $widget{"lcf_e0$i"} -> configure(-state=>'normal');
						 };
					       };
					     })
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');

  $frame -> Button(-text=>'Use marked groups',
		   @button_list,
		   -borderwidth=>1,
		   -command=>[\&lcf_use_marked, \%lcf_params])
    -> pack(-side=>'top', -fill=>'x', -padx=>2, -anchor=>'w');

  my $ff = $frame -> Frame()
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');
  $ff -> Label(-text=>"Add noise")
    -> pack(-side=>'left', -padx=>2);
  $widget{lcf_noise} = $ff -> Entry(-width           => 7,
				    -textvariable    => \$lcf_params{noise},
				    -validate        => 'none',
				    -validatecommand => [\&set_variable, 'lcf_noise']
				   )
    -> pack(-side=>'left');
  $ff -> Label(-text=>" to data")
    -> pack(-side=>'left', -padx=>2);

  $ff = $frame -> Frame()
    -> pack(-side=>'top', -padx=>2, -anchor=>'w');
  $ff -> Label(-text=>"Use at most")
    -> pack(-side=>'left', -padx=>2);
  $widget{lcf_maxstan} = $ff -> NumEntry(-orient => 'horizontal',
					    -minvalue => 2,
					    -maxvalue => $config{linearcombo}{maxspectra},
					    -textvariable => \$lcf_params{maxstan},
					    -width=>3)
    -> pack(-side=>'left');
  $ff -> Label(-text=>" standards")
    -> pack(-side=>'left', -padx=>2);

  $widget{lcf_maxfit} = $frame -> Label(-font=>$config{fonts}{smbold},
					-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -padx=>2, -anchor=>'center', -fill=>'x');




  ## frame containing the grid of widgets for selecting the
  ## standards spectra
  $frame = $st -> Scrolled('HList',
			   -scrollbars	=> 'oe',
			   -header	=> 1,
			   -columns	=> 6,
			   -borderwidth	=> 0,
			   -relief	=> 'flat',
			   -highlightcolor => $config{colors}{background},)
    -> pack(-side=>'top', -fill =>'both', -padx=>4, -pady=>4);
  BindMouseWheel($frame);
  #($frame->children)[2] -> configure(-highlightcolor=>$config{colors}{background});
  #foreach (($frame->children)[2]->configure) {no warnings; no strict;  print join(" ", @$_), $/};
  $frame -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));

  my $style = $frame -> ItemStyle('text',
				  -font=>$config{fonts}{small},
				  -anchor=>'w',
				  -foreground=>$config{colors}{activehighlightcolor});
  $frame -> headerCreate(0,
			 -text=>" ",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);
  $frame -> headerCreate(1,
			 -text=>"Standards",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);
  $frame -> headerCreate(2,
			 -text=>"weight",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);
  $frame -> headerCreate(3,
			 -text=>"e0",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);
  $frame -> headerCreate(4,
			 -text=>"fit?",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);
  $frame -> headerCreate(5,
			 -text=>"req.",
			 -style=>$style,
			 -headerbackground=>$config{colors}{background},
			 -borderwidth	   => 1,);



  $lcf_params{req} = $groups{$current}->{"lcf_req"} || q{};
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $lcf_params{"standard$i"}     = $groups{$current}->{"lcf_standard$i"}     || 'None';
    $lcf_params{"e0$i"}           = $groups{$current}->{"lcf_e0$i"}           || $config{linearcombo}{fite0};
    $lcf_params{"e0val$i"}        = $groups{$current}->{"lcf_e0val$i"}        || 0;
    $lcf_params{"value$i"}        = $groups{$current}->{"lcf_value$i"}        || 0;


    $frame -> add($i);
    $frame -> itemCreate($i, 0, -itemtype=>'text',   -text=>$i, -style=>$style);
    $widget{"lcf_standard_list$i"} = $frame -> BrowseEntry(-variable => \$lcf_params{"standard_lab$i"},
							   @browseentry_list,
							   -width=>18,
							   -browsecmd => sub {
							     my $text = $_[1];
							     my $this = $1 if ($text =~ /^(\d+):/);
							     Echo("Failed to match in browsecmd.  Yikes!  Complain to Bruce."), return unless ($this or ($this eq '0'));
							     #$this -= 1;
							     $lcf_params{"standard$i"}=$lcf_params{keys}->[$this];
							     $groups{$current} -> MAKE("lcf_standard$i"     => $lcf_params{keys}->[$this],
										       "lcf_standard_lab$i" => $lcf_params{"standard_lab$i"});
							     if ($this == 0) { # select None
							       $lcf_params{"standard$i"}     = "None";
							       $lcf_params{"standard_lab$i"} = "0: None";
							       $lcf_params{"value$i"}	     = 0;
							       $lcf_params{"e0$i"}	     = 0;
							       $lcf_params{"e0val$i"}	     = 0;
							       $lcf_params{"delta_value$i"}  = 0;
							       $lcf_params{"delta_e0val$i"}  = 0;
							       $groups{$current} -> MAKE("lcf_value$i"	     => 0,
											 "lcf_e0$i"	     => 0,
											 "lcf_e0val$i"	     => 0,
											 "lcf_delta_value$i" => 0,
											 "lcf_delta_e0val$i" => 0,
											);
							     };
							     &lcf_initialize(\%lcf_params, 2);
							   });
    $widget{"lcf_standard_list$i"} -> insert("end", "0: None");
    my $j = 1;
    foreach my $s (@keys) {
      next if ($s eq 'None');
      $groups{$s}->MAKE(lcf_menu_label => "$j: $groups{$s}->{label}");
      $widget{"lcf_standard_list$i"} -> insert("end", "$j: $groups{$s}->{label}");
      ++$j;
    };
    ## make sure menu labels are up to date
    my $label = "";
    ($label = $groups{$groups{$current}->{"lcf_standard$i"}}->{lcf_menu_label})
      if (exists $groups{$current}->{"lcf_standard$i"});
    $lcf_params{"standard_lab$i"} = $label || '0: None';




    $frame -> itemCreate($i, 1, -itemtype=>'window', -widget=>$widget{"lcf_standard_list$i"});
    my $en = $frame -> Entry(-width=>6,
 			     -textvariable=>\$lcf_params{"value$i"});
    $frame -> itemCreate($i, 2, -itemtype=>'window', -widget=>$en);
    $widget{"lcf_e0val$i"} = $frame -> Entry(-width=>6,
 					     #-state=>($lcf_params{"e0$i"}) ? 'normal' : 'disabled',
 					     -textvariable=>\$lcf_params{"e0val$i"});
    $frame -> itemCreate($i, 3, -itemtype=>'window', -widget=>$widget{"lcf_e0val$i"});
    $widget{"lcf_e0$i"} = $frame -> Checkbutton(-variable=>\$lcf_params{"e0$i"},
						-selectcolor=>$config{colors}{single},
						#-command=>sub{$widget{"lcf_e0val$i"}->configure(-state=>($lcf_params{"e0$i"})?'normal':'disabled')},
					       );
    $frame -> itemCreate($i, 4, -itemtype=>'window', -widget=>$widget{"lcf_e0$i"});
    $widget{"lcf_req$i"} = $frame -> Radiobutton(-variable=>\$lcf_params{req},
						 -value=>$i,
						 -selectcolor=>$config{colors}{single},
						 #-command=>sub{$widget{"lcf_e0val$i"}->configure(-state=>($lcf_params{"e0$i"})?'normal':'disabled')},
					       );
    $frame -> itemCreate($i, 5, -itemtype=>'window', -widget=>$widget{"lcf_req$i"});
  };






  ## a place to write information after the fit is finished
  $frame = $re -> Frame()
    -> pack(-side=>'top', -fill=>'both', -padx=>4, -expand=>1);

  $widget{lcf_text} = $frame -> Scrolled("ROText", -scrollbars=>'osoe',
					 -wrap=>'none',
					 -height=>1,
					 -width=>40,
					 -font=>$config{fonts}{fixed})
    -> pack(-fill=>'both', -expand=>1);
  disable_mouse3($widget{lcf_text}->Subwidget('rotext'));
  $widget{lcf_text} -> Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
							  ($is_windows) ? () : (-width=>8));
  $widget{lcf_text} -> Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
							  ($is_windows) ? () : (-width=>8));
  $widget{lcf_text} -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
  my $smbold = $config{fonts}{smbold};
  my $red = $config{colors}{single};
  $widget{lcf_text} -> tagConfigure('error',
				    -lmargin1   => 4,
				    -font	=> $smbold,
				    -foreground	=> $red,
				    -background	=> 'white');

  $frame = $buttonframe -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -padx=>0);





  ## table for selecting a fit from the combinatorial fits
  $widget{lcf_combo_group} = $co -> Label(-foreground=>$config{colors}{activehighlightcolor},
					  -font=>$config{fonts}{smbold})
    -> pack(-side=>'top', -fill=>'x');
  $widget{lcf_select_table} = $co -> Scrolled("HList",
					      -columns    => 3,
					      -header     => 1,
					      -height     => 1,
					      -scrollbars => 'osoe',
					      -background => $config{colors}{background},
					      -selectbackground=> $config{colors}{current},
					     )
    -> pack(-side=>'top', -fill=>'both', -expand=>1);
  BindMouseWheel($widget{lcf_select_table});
  $widget{lcf_select_table} -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $widget{lcf_select_table} -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $widget{lcf_select_table}->bind('<ButtonPress-3>',\&lcf_post_menu);

  my $header_style = $widget{lcf_select_table} -> ItemStyle('text',
							    -font=>$config{fonts}{small},
							    -anchor=>'w',
							    -foreground=>$config{colors}{activehighlightcolor});
  $widget{lcf_select_table} -> headerCreate(0,
					    -text=>"Standards",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);
  $widget{lcf_select_table} -> headerCreate(1,
					    -text=>"R-factor",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);
  $widget{lcf_select_table} -> headerCreate(2,
					    -text=>"Reduced chi-square",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);

  ## table for displaying the results from a selected fit
  my $lf = $co -> LabFrame(-label      => 'Results for the selected fit',
			   -foreground => $config{colors}{activehighlightcolor},
			   -labelside  => 'acrosstop')
    -> pack(-fill=>'both', -expand=>1);

  $widget{lcf_result_table} = $lf -> Scrolled("HList",
					      -columns		=> 4,
					      -header		=> 1,
					      -height           => 4,
					      -scrollbars	=> 'osoe',
					      -background	=> $config{colors}{background},
					      -selectbackground => $config{colors}{background},
					     )
    -> pack(-side=>'top', -fill=>'both', -expand=>1);
  BindMouseWheel($widget{lcf_result_table});
  $widget{lcf_result_table} -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $widget{lcf_result_table} -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $header_style = $widget{lcf_result_table} -> ItemStyle('text',
							 -font=>$config{fonts}{small},
							 -anchor=>'w',
							 -foreground=>$config{colors}{activehighlightcolor});
  $widget{lcf_result_table} -> headerCreate(0,
					    -text=>"#",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);
  $widget{lcf_result_table} -> headerCreate(1,
					    -text=>"Standard",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);
  $widget{lcf_result_table} -> headerCreate(2,
					    -text=>"Weight",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);
  $widget{lcf_result_table} -> headerCreate(3,
					    -text=>"E0",
					    -style=>$header_style,
					    -headerbackground=>$config{colors}{background},
					    -borderwidth	   => 1,);

  ##   $frame = $co -> Frame() -> pack(-fill=>'both', -side=>'bottom');
  ##   $frame -> Button(-text=>'Make groups of all fits',
  ## 		   @button_list,
  ## 		   -width=>1,
  ## 		   -command=>sub{Echo("Nothin' yet.")})
  ##     -> pack(-side=>'left', -fill=>'x', -expand=>1);
  $lf -> Button(-text=>'Write CSV report for all fits',
		@button_list,
		-width=>1,
		-command=>\&lcf_csv_report)
    -> pack(-side=>'left', -fill=>'x', -expand=>1);


  ## and finally....
  &lcf_initialize(\%lcf_params, 1);
  $top -> Busy;
  $groups{$current}->{lcf_fitspace} ||= 'e';
  $groups{$current}->{lcf_fitmin}   ||= ($groups{$current}->{lcf_fitspace} eq 'k') ? $config{linearcombo}{fitmin_k} : $config{linearcombo}{fitmin};
  $groups{$current}->{lcf_fitmax}   ||= ($groups{$current}->{lcf_fitspace} eq 'k') ? $config{linearcombo}{fitmax_k} : $config{linearcombo}{fitmax};
  ## plot the current group
  if ($lcf_params{fitspace} =~ '[de]') {
    $lcf_params{fitmin} = ($groups{$current}->{lcf_fitspace} =~ '[de]') ? $groups{$current}->{lcf_fitmin} : $config{linearcombo}{fitmin};
    $lcf_params{fitmax} = ($groups{$current}->{lcf_fitspace} =~ '[de]') ? $groups{$current}->{lcf_fitmax} : $config{linearcombo}{fitmax};
    lcf_quickplot_e(\%lcf_params);
  } else {
    $lcf_params{fitmin} = ($groups{$current}->{lcf_fitspace} eq 'k') ? $groups{$current}->{lcf_fitmin} : $config{linearcombo}{fitmin_k};
    $lcf_params{fitmax} = ($groups{$current}->{lcf_fitspace} eq 'k') ? $groups{$current}->{lcf_fitmax} : $config{linearcombo}{fitmax_k};
    lcf_quickplot_k(\%lcf_params);
    $widget{lcf_operations} -> entryconfigure(7, -state=>'normal', -style=>$lcf_params{normal_style});
  };
  if (exists $lcf_data{$current}) {
    my @list = $lcf_data{$current}{results}->[0];
    $lcf_params{rfact}  = $list[1];
    $lcf_params{chisqr} = $list[2];
    $lcf_params{chinu}  = $list[3];
    $lcf_params{nvarys} = $list[4];
    $lcf_params{ndata}  = $list[5];
    lcf_display();
  };
  if (exists $groups{$current}->{lcf_fit} and $groups{$current}->{lcf_fit}) {
    lcf_results(\%lcf_params);
    $widget{lcf_operations} -> entryconfigure(4, -state=>'normal', -style=>$$hash_pointer{normal_style});
  };
  &lcf_initialize(\%lcf_params, 1);

  $widget{lcf_fitmin} -> insert(0, $$hash_pointer{fitmin});
  $widget{lcf_fitmin} -> configure(-validate=>"key");
  $widget{lcf_fitmax} -> insert(0, $$hash_pointer{fitmax});
  $widget{lcf_fitmax} -> configure(-validate=>"key");
  $widget{lcf_noise}  -> configure(-validate=>"key");

  $top -> Unbusy;
  $top -> update;

};

sub lcf_set_variable {
  my ($k, $entry, $prop) = (shift, shift, shift);
  ($entry =~ /^\s*$/) and ($entry = 0);	# error checking ...
  ($entry =~ /^\s*-$/) and return 1;	# error checking ...
  ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
  my $param = substr($k,4);
  $$hash_pointer{$param} = $entry;
  $groups{$current} -> MAKE($k=>$entry);
  if ($param =~ /fitm(ax|in)/) {
    my $kk = ($$hash_pointer{fitspace} eq 'k') ? $param."_k" : $param."_e";
    $$hash_pointer{$kk} = $entry;
    $groups{$current} -> MAKE("lcf_$kk"=>$entry);
  };
  project_state(0);
  return 1;
};

sub lcf_multiplexer {
  my $lcf_params_ref = $_[0];
  my $pick = $widget{lcf_operations} -> selectionGet;
  ($pick = $pick->[0]) if (ref($pick) =~ /ARRAY/); # Tk 800 returns a scalar
                                                   # Tk 804 returns an array ref
 SWITCH: {
    lcf_fit($lcf_params_ref, 1),        last SWITCH if ($pick == 1);
    lcf_combinatorics($lcf_params_ref), last SWITCH if ($pick == 2);
    lcf_marked($lcf_params_ref),        last SWITCH if ($pick == 3);
    lcf_report(),                       last SWITCH if ($pick == 4);
    lcf_save_marked_report(),           last SWITCH if ($pick == 5);
    lcf_plot($lcf_params_ref),          last SWITCH if ($pick == 6);
    lcf_plot_r($lcf_params_ref),        last SWITCH if ($pick == 7);
    lcf_group($lcf_params_ref, 'fit'),  last SWITCH if ($pick == 8);
    lcf_group($lcf_params_ref, 'diff'), last SWITCH if ($pick == 9);
    lcf_constrain("all"),               last SWITCH if ($pick == 10);
    lcf_constrain("marked"),            last SWITCH if ($pick == 11);
    lcf_reset($lcf_params_ref, 0),      last SWITCH if ($pick == 12);
  };
  $widget{lcf_operations} -> selectionClear;
  $widget{lcf_operations} -> anchorClear;
};




sub lcf_quickplot {
  my $rlp = $_[0];
  if ($$rlp{fitspace} eq 'k') {
    $$rlp{fitmin_k} = $$rlp{fitmin};
    $$rlp{fitmax_k} = $$rlp{fitmax};
  } else {
    $$rlp{fitmin_e} = $$rlp{fitmin};
    $$rlp{fitmax_e} = $$rlp{fitmax};
  };
  lcf_quickplot_k($rlp), return if ($$rlp{fitspace} eq 'k');
  lcf_quickplot_e($rlp);
};


sub lcf_quickplot_e {
  my $rlp = $_[0];
  Error("\"$groups{$current}->{label}\" cannot be plotted in energy."), return if ($groups{$current}->{is_chi} or
										   $groups{$current}->{is_rsp} or
										   $groups{$current}->{is_qsp});
  my $how = ($$rlp{fitspace} eq 'e') ? 'emn' : 'emnd';
  $groups{$current}->plotE($how, $dmode, \%plot_features, \@indicator);
  my ($emin, $emax) = ($$rlp{enot}+$$rlp{fitmin}, $$rlp{enot}+$$rlp{fitmax});

  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  my $sets = "set(l___cf.x = $current.energy+$groups{$current}->{bkg_eshift},\n";
  if ($$rlp{fitspace} eq 'd') {
    $sets .= "    l___cf.y = deriv($current.norm)/deriv($current.energy)+$groups{$current}->{plot_yoffset})";
  } else {
    $sets .= "    l___cf.y = $current.$suff+$groups{$current}->{plot_yoffset})";
  };
  $groups{$current}->dispose($sets, $dmode);
  my @x = Ifeffit::get_array("l___cf.x");
  my @y = Ifeffit::get_array("l___cf.y");
  my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});

  $groups{$current}->plot_vertical_line($emin, $ymin, $ymax, $dmode, "fit range", 0);
  $groups{$current}->plot_vertical_line($emax, $ymin, $ymax, $dmode, "", 0);
  $last_plot='e';
  $plotsel -> raise('e');
};
sub lcf_quickplot_k {
  my $rlp = $_[0];
  Error("\"$groups{$current}->{label}\" cannot be plotted in k."), return if ($groups{$current}->{is_xanes} or
									      $groups{$current}->{is_rsp}   or
									      $groups{$current}->{is_qsp});
  $groups{$current}->plotk('kw', $dmode, \%plot_features, \@indicator);
  my ($kmin, $kmax) = ($$rlp{fitmin}, $$rlp{fitmax});
  ##my ($kw, $group) = ($groups{$current}->{fft_kw}, $groups{$current}->{group});
  my ($kw, $group, $yoff) = ($plot_features{kw}, $groups{$current}->{group}, $groups{$current}->{plot_yoffset});
  my @x = Ifeffit::get_array("$group.k");
  $groups{$current}->dispose("set(l___cf.kw = $group.chi*$group.k^$kw)", $dmode);
  my @y = Ifeffit::get_array("l___cf.kw");
  my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'k', 0);
  $ymin = $ymin*1.05 + $yoff;
  $ymax = $ymax*1.05 + $yoff;
  $groups{$current}->plot_vertical_line($kmin, $ymin, $ymax, $dmode, "fit range", 0);
  $groups{$current}->plot_vertical_line($kmax, $ymin, $ymax, $dmode, "", 0);
  $last_plot='k';
  $plotsel -> raise('k');
};


## need to verify that the current group is not one of the standards
## selected in the standards grid.  also need to count the number of
## standards for the sake of the initial guesses for the weights
sub lcf_initialize {
  my ($rlp, $reset) = @_;
  my $n = 0;
  my $unknown_stan = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $$rlp{"delta_value$i"} = 0;
    next unless exists($$rlp{"standard$i"});
    ++$n if ($$rlp{"standard$i"} ne 'None');
    ++$unknown_stan if ($$rlp{"standard$i"} eq $current);
  };
  if ($reset == 1) {
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      if (exists $groups{$current}->{"lcf_value$i"}) {
	$$rlp{"value$i"} = $groups{$current}->{"lcf_value$i"};
      } else {
	$$rlp{"value$i"} = ($$rlp{"standard$i"} eq 'None') ? 0 : sprintf("%.3f", 1/$n);
      };
    };
  } elsif ($reset == 2) {
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      $$rlp{"value$i"} = ($$rlp{"standard$i"} eq 'None') ? 0 : sprintf("%.3f", 1/$n);
    };
  };
  my $state = ($unknown_stan) ? 'disabled' : 'normal';
  my $style = ($unknown_stan) ? $$rlp{disabled_style} : $$rlp{normal_style};
  $widget{lcf_operations} -> entryconfigure(1, -state=>$state,     -style=>$style);
  $widget{lcf_operations} -> entryconfigure(3, -state=>$state,     -style=>$style);
  my $nn = ($$rlp{fitspace} eq 'k') ? 1 : 2;
  $widget{lcf_operations} -> entryconfigure(1, -state=>'disabled', -style=>$$rlp{disabled_style}) unless ($n>=$nn);
  $widget{lcf_operations} -> entryconfigure(2, -state=>$state,     -style=>$style);
  $widget{lcf_operations} -> entryconfigure(2, -state=>'disabled', -style=>$$rlp{disabled_style}) unless ($n>=3);
  $widget{lcf_operations} -> entryconfigure(3, -state=>'disabled', -style=>$$rlp{disabled_style}) unless ($n>=$nn);
  $state = (exists $groups{$current}->{lcf_fit} and $groups{$current}->{lcf_fit}) ? 'normal' : 'disabled';
  $style = (exists $groups{$current}->{lcf_fit} and $groups{$current}->{lcf_fit}) ? $$rlp{normal_style} : $$rlp{disabled_style};
  $widget{lcf_operations} -> entryconfigure(4, -state=>$state,     -style=>$style);
  $widget{lcf_operations} -> entryconfigure(5, -state=>'normal',   -style=>$$rlp{normal_style}) if (-e $groups{"Default Parameters"}->find('athena', 'temp_lcf'));
  $state = ($n) ? 'normal' : 'disabled';
  $style = ($n) ? $$rlp{normal_style} : $$rlp{disabled_style};
  $widget{lcf_operations} -> entryconfigure(6, -state=>$state,     -style=>$style);
  $widget{lcf_operations} -> entryconfigure(8, -state=>'disabled', -style=>$$rlp{disabled_style});
  $widget{lcf_operations} -> entryconfigure(9, -state=>'disabled', -style=>$$rlp{disabled_style});

  $widget{lcf_maxstan} -> configure(-state=>($unknown_stan) ? 'disabled' : 'normal');
  $widget{lcf_maxstan} -> configure(-state=>'disabled') unless ($n>=3);
  $widget{lcf_linear}  -> configure(-state=>'normal');
  $widget{lcf_e0all}   -> configure(-state=>'normal');
  if ($$rlp{fitspace} eq 'k') {
    $widget{lcf_linear} -> configure(-state=>'disabled');
    $widget{lcf_e0all}  -> configure(-state=>'disabled');
  } elsif ($$rlp{fitspace} eq 'd') {
    $widget{lcf_linear} -> configure(-state=>'disabled');
  };
};




## this multiplexes between the norm(E) and chi(k) fits
sub lcf_fit {
  my $rlp = $_[0];
  $groups{$current} -> dispose("set &status = 0\n", $dmode);
  ## need to clean up error bars from the last fit.  this should be
  ## innocuous if those scalars do not exist in Ifeffit
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $groups{$current}->MAKE("lcf_delta_e0val$i"  => 0,
			    "lcf_delta_value$i"  => 0,
			   );
    $groups{$current} -> dispose("erase delta_e$i delta_w$i delta_ww$i", $dmode);
  };
  $groups{$current} -> dispose("erase delta_yint delta_slope", $dmode);
  $$rlp{fit_status} = 0;
  if ($$rlp{fitspace} eq 'k') {
    $$rlp{fitmin_k} = $$rlp{fitmin};
    $$rlp{fitmax_k} = $$rlp{fitmax};
  } else {
    $$rlp{fitmin_e} = $$rlp{fitmin};
    $$rlp{fitmax_e} = $$rlp{fitmax};
  };
  $$rlp{fitting} = 1;
 SWITCH: {
    lcf_fit_k(@_), last SWITCH if ($$rlp{fitspace} eq 'k');
    lcf_fit_e(@_);
  };
  $$rlp{fitting} = 0;
};

sub lcf_marked {
  my $rlp = $_[0];
  my $start = $current;
  #foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
  #  $groups{$current} -> MAKE("lcf_standard$i"     => $$rlp{"standard$i"});
  #  next if ($$rlp{"standard$i"} eq 'None');
  #  $groups{$current} -> MAKE("lcf_standard_lab$i" => $$rlp{"standard_lab$i"},
  #			      "lcf_value$i"        => $$rlp{"value$i"},
  #			      "lcf_e0$i"           => $$rlp{"e0$i"},
  #			      "lcf_e0val$i"        => $$rlp{"e0val$i"},
  #			      );
  #};
  if ($config{linearcombo}{marked_query} eq 'set') {
    lcf_constrain("marked");
  } elsif ($config{linearcombo}{marked_query} eq 'skip') {
    1; ## do nothing
  } else {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "You are about to do linear combination fits on the marked groups.  Would you like to constrain the parameters of all marked groups to those of the current group?",
		     -title          => 'Athena: Constrain parameters for linear combination fit?',
		     -buttons        => ["Constrain", "Do not constrain", "Cancel fits"],
		     -default_button => 'Constrain');
    my $answer = $dialog->Show();
    return if ($answer eq "Cancel fits");
    lcf_constrain("marked") if ($answer eq "Constrain");
  };
  Echo("Fitting all marked groups ...");
  $top -> Busy;
  unlink($groups{"Default Parameters"}->find('athena', 'temp_lcf'))
    if (-e $groups{"Default Parameters"}->find('athena', 'temp_lcf'));
  my $n_fits = 0;
  tie my $timer, 'Time::Stopwatch';
  foreach my $g (&sorted_group_list) {
    next unless $marked{$g};
    my $is_ok = 1;
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      $is_ok = 0 if ($g eq $$rlp{"standard$i"});
    };
    next unless $is_ok;
    ++$n_fits;
    set_properties(0, $g, 0);
    lcf_fit($rlp);
  };
  my $elapsed = $timer;
  undef $timer;
  $elapsed = sprintf("%d fits in %.0f min, %.0f sec", $n_fits, $elapsed/60, $elapsed%60);
  lcf_marked_report();
  set_properties(0, $start,0);
  $widget{lcf_operations} -> entryconfigure(5, -state=>'normal', -style=>$$rlp{normal_style});
  Echo("Fitting all marked groups ... done!  ($elapsed)");
  $top -> Unbusy;
};

sub lcf_fit_e {
  my $rlp = $_[0];
  my $plot = $_[1];
  my $bg = $config{colors}{background};
  $widget{lcf_maxfit} -> configure(-foreground=>'black',
				   -background=>$bg,
				   -text=>"") unless $$rlp{doing_combinatorics};

  my $abort = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$rlp{"standard$i"} eq 'None');
    my $this = $$rlp{"standard$i"};
    ++$abort if $groups{$this}->{is_chi};
  };
  Error("Fit aborted!  One or more of your standards cannot be plotted in energy."), return if $abort;

  my $how = ($$rlp{fitspace} eq 'e') ? 'norm(E)' : 'deriv(E)';
  Echo("Linear combination fitting $groups{$current}->{label} in $how ... ");
  my $is_busy = grep (/Busy/, $top->bindtags);
  $top -> Busy unless $is_busy;
  my $group  = $groups{$current}->{group};
  my $eshift = $groups{$current}->{bkg_eshift};
  $groups{$current}->dispatch_bkg($dmode) if $groups{$current}->{update_bkg};
  my $command = "## performing linear combination fit in $how\nunguess\n";
  $command .= "erase \@group l___cf\n";
  my $define = "def l___cf.mix =";
  push @{ $$rlp{deflist} }, "l___cf.mix";
  $$rlp{filestring} = "linear combination in E of";
  my @weights;
  my @which;

  $groups{$current}->dispose($command, $dmode);
  $command = "";
  ## make the unknown data arrays
  lcf_arrays_e(1);

  ## make sure each standard is up-to-date with respect to
  ## normalization
  $$rlp{nstandards} = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$rlp{"standard$i"} eq 'None');
    ++$$rlp{nstandards};
    push @which, $i;
    my $this = $$rlp{"standard$i"};
    $groups{$this}->dispatch_bkg($dmode) if $groups{$this}->{update_bkg};
    $$rlp{filestring} .= " " . $$rlp{"standard_lab$i"};
  };
  ## the last standard needs to be handled slightly differently
  my $last = pop @which;

  ## interpolate each standard onto the grid of the unknown, guess a
  ## weight and (if requested) an e0 shift.  make sure to use the
  ## flattened spectrum if appropriate
  foreach my $j (@which) {
    my $this = $$rlp{"standard$j"};
    my $esh  = sprintf("%.3f",$groups{$this}->{bkg_eshift});
    my $suff = ($groups{$this}->{bkg_flatten}) ? 'flat' : 'norm';
    ($suff = 'norm') if ($$rlp{fitspace} eq 'd');
    $command .= "# $this is $groups{$this}->{label}\n";
    if ($$rlp{e0all}) {
      if ($j == $which[0]) {
	$command .= "guess e$j = " . $$rlp{"e0val$j"} . "\n";
      } else {
	$command .= "def e$j = e$which[0]\n";
	push @{ $$rlp{deflist} }, "e$j";
      };
    } else {
      if ($$rlp{"e0$j"}) {
	$command .= "guess e$j = " . $$rlp{"e0val$j"} . "\n";
      } else {
	$command .= "set e$j = " .$$rlp{"e0val$j"} . "\n";
      };
    };
    my $function = ($$rlp{fitspace} eq 'd') ? "deriv($this.$suff)/deriv($this.energy)" : "$this.$suff";
    if ($$rlp{nonneg}) {
      $command .= "guess ww$j = " . $$rlp{"value$j"} . "\n";
      $command .= "def w$j = max(0,min(ww$j,1))\n";
      push @{ $$rlp{deflist} }, "w$j";
      $command .= "def l___cf.$j = abs(w$j)*splint($this.energy+e$j+$esh, $function, l___cf.energy)\n";
      push @{ $$rlp{deflist} }, "l___cf.$j";
    } else {
      $command .= "guess w$j = " . $$rlp{"value$j"} . "\n";
      $command .= "def l___cf.$j = w$j*splint($this.energy+e$j+$esh, $function, l___cf.energy)\n";
      push @{ $$rlp{deflist} }, "l___cf.$j";
    };
    $define  .= " l___cf.$j +";
    push @weights, "w$j";
  };

  ## do the same for the last spectrum, except def its weight to be
  ## one minus the sum of all the rest of the weights
  my $this = $$rlp{"standard$last"};
  my $esh  = sprintf("%.3f",$groups{$this}->{bkg_eshift});
  my $suff = ($groups{$this}->{bkg_flatten}) ? 'flat' : 'norm';
  ($suff = 'norm') if ($$rlp{fitspace} eq 'd');
  my @www = ($$rlp{nonneg}) ? map { "abs(".$_.")" } @weights : @weights;
  $command .= "# $this is $groups{$this}->{label}\n";
  if ($$rlp{100}) {
    $command .= "def w$last = max(0, 1 - (" . join("+", @weights) . "))\n";
    push @{ $$rlp{deflist} }, "w$last";
  } else {
    if ($$rlp{nonneg}) {
      $command .= "guess ww$last = " . $$rlp{"value$last"} . "\n";
      $command .= "def w$last = max(0,min(ww$last,1))\n";
      push @{ $$rlp{deflist} }, "w$last";
    } else {
      $command .= "guess w$last = " . $$rlp{"value$last"} . "\n";
    };
  };
  push @weights, "w$last";
  if ($$rlp{e0all}) {
    $command .= "def e$last = e$which[0]\n";
    push @{ $$rlp{deflist} }, "e$last";
  } elsif ($$rlp{"e0$last"}) {
    $command .= "guess e$last = " . $$rlp{"e0val$last"} ."\n";
  } else {
    $$rlp{"e0val$last"} ||= 0;
    $command .= "set e$last = " . $$rlp{"e0val$last"} ."\n";
  };
  my $function = ($$rlp{fitspace} eq 'd') ? "deriv($this.$suff)/deriv($this.energy)" : "$this.$suff";
  $command .= "def l___cf.$last = w$last*splint($this.energy+e$last+$esh, $function, l___cf.energy)\n";
  push @{ $$rlp{deflist} }, "l___cf.$last";
  $define  .= " l___cf.$last";

  ## add a line to the fitting function, if requested.  the line
  ## should only be applied after e0, so use a step function
  if (($$rlp{fitspace} eq 'e') and $$rlp{linear}) {
    $command .= "step l___cf.energy $groups{$current}->{bkg_eshift} $groups{$current}->{bkg_e0} l___cf.theta\n";
    #$command .= "step $group.energy $$rlp{fitmin} $group.theta\n";
    $command .= "guess slope=0\nguess yint=0\n";
    $define .= " + l___cf.theta*(yint + slope*l___cf.energy)";
  };
  $define  .= "\n";
  $command .= $define;

  ## def the residual array and minimize
  my ($emin, $emax) = ($$rlp{enot}+$$rlp{fitmin},
		       $$rlp{enot}+$$rlp{fitmax});
  $command .= "def l___cf.resid = l___cf.mix - l___cf.data\n";
  push @{ $$rlp{deflist} }, "l___cf.resid";
  $command .= "minimize(l___cf.resid, x=l___cf.energy, xmin=$emin, xmax=$emax)\n";
  $groups{$current}->dispose($command, $dmode);
#  if ($$rlp{nonneg}) {
#    foreach my $w (@weights) {
#      $groups{$current}->dispose("set $w = abs($w)\n", $dmode);
#    };
#  };

  ## store the fit results in the object
  $$rlp{fit_status} = lcf_values($rlp);
  $groups{$current}->MAKE(lcf_fit	  => 1,
			  lcf_fitspace	  => $$rlp{fitspace},
			  lcf_fit_status  => $$rlp{fit_status},
			  lcf_linear	  => $$rlp{linear},
			  lcf_nonneg	  => $$rlp{nonneg},
			  lcf_100	  => $$rlp{100},
			  lcf_e0all	  => $$rlp{e0all},
			  lcf_slope	  => $$rlp{slope},
			  lcf_yint	  => $$rlp{yint},
			  lcf_delta_slope => $$rlp{delta_slope},
			  lcf_delta_yint  => $$rlp{delta_yint},
			  lcf_fitmin	  => $$rlp{fitmin},
			  lcf_fitmax	  => $$rlp{fitmax},);
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $groups{$current}->MAKE("lcf_standard$i"     => $$rlp{"standard$i"});
    next if ($$rlp{"standard$i"} eq 'None');
    $groups{$current}->MAKE("lcf_standard_lab$i" => $$rlp{"standard_lab$i"},
			    "lcf_e0$i"           => $$rlp{"e0$i"},
			    "lcf_e0val$i"        => $$rlp{"e0val$i"},
			    "lcf_delta_e0val$i"  => $$rlp{"delta_e0val$i"},
			    "lcf_value$i"        => $$rlp{"value$i"},
			    "lcf_delta_value$i"  => $$rlp{"delta_value$i"},
			   );
  };
  project_state(0);
  ## write a report to the text box
  lcf_statistics($rlp);
  lcf_results($rlp) if ($plot);

  my $red = $config{colors}{single};

  lcf_undef($rlp);
  ## plot the results
  lcf_plot_e($rlp) if $plot;

  ## and finish up
  $widget{lcf_operations} -> entryconfigure(4, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(8, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(9, -state=>'normal', -style=>$$rlp{normal_style});
  Echo("Linear combination fitting $groups{$current}->{label} in norm(E) ... done!");
  $top -> Unbusy unless $is_busy;
};


sub lcf_fit_k {
  my $rlp = $_[0];
  my $plot = $_[1];
  my $bg = $config{colors}{background};
  $widget{lcf_maxfit} -> configure(-foreground=>'black',
				   -background=>$bg,
				   -text=>"") unless $$rlp{doing_combinatorics};

  my $abort = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$rlp{"standard$i"} eq 'None');
    my $this = $$rlp{"standard$i"};
    ++$abort if $groups{$this}->{is_xanes};
  };
  Error("Fit aborted!  One or more of your standards cannot be plotted in k."), return if $abort;

  Echo("Linear combination fitting $groups{$current}->{label} in chi(k) ... ");
  $top -> Busy;
  my $group = $groups{$current}->{group};
  ##my $kw = $groups{$current}->{fft_kw};
  my $kw = $plot_features{kw};
  $$rlp{kw} = $kw;
  $groups{$current}->dispatch_bkg($dmode) if $groups{$current}->{update_bkg};
  my $command = "## performing linear combination fit in chi(k)\nunguess\n";
  $command .= "erase \@group l___cf\n";
  my $define = "def l___cf.mix =";
  push @{ $$rlp{deflist} }, "l___cf.mix";
  $$rlp{filestring} = "linear combination in k of";
  my @weights;
  my @which;
  $groups{$current}->dispose($command, $dmode);
  $command = "";
  lcf_arrays_k(1);

  ## make sure each standard is up-to-date with respect to
  ## normalization
  $$rlp{nstandards} = 0;
  my $smallest_kmax = 10000;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$rlp{"standard$i"} eq 'None');
    ++$$rlp{nstandards};
    push @which, $i;
    my $this = $$rlp{"standard$i"};
    $groups{$this}->dispatch_bkg($dmode) if $groups{$this}->{update_bkg};
    $$rlp{filestring} .= " " . $$rlp{"standard_lab$i"};

    ## need to make sure that the fitting range is not beyond any of the data
    my @y = Ifeffit::get_array($this . ".k");
    ($smallest_kmax = $y[$#y]) if ($y[$#y] < $smallest_kmax);
  };

  ## the last standard needs to be handled slightly differently
  my $last = ($$rlp{nstandards} > 1) ? pop @which : q{};

  ## guess a weight and (if requested) an e0 shift. add this to the mix
  foreach my $j (@which) {
    my $this = $$rlp{"standard$j"};
    $command .= "# $this is $groups{$this}->{label}\n";
    if ($$rlp{nonneg}) {
      $command .= "guess ww$j = " . $$rlp{"value$j"} . "\n";
      $command .= ($last) ? "def w$j = max(0,min(ww$j,1))\n" : "def w$j = ww$j\n";
    } else {
      $command .= "guess w$j = " . $$rlp{"value$j"} . "\n";
    };
    push @{ $$rlp{deflist} }, "w$j";
    $command .= "def l___cf.$j = w$j*$this.chi*$this.k^$kw\n";
    push @{ $$rlp{deflist} }, "l___cf.$j";
    $define  .= " l___cf.$j +";
    push @weights, "w$j";
  };

  if ($last) {
    ## do the same for the last spectrum, except def its weight to be
    ## one minus the sum of all the rest of the weights
    my $this = $$rlp{"standard$last"};
    my $suff = ($groups{$this}->{bkg_flatten}) ? 'flat' : 'norm';
    my @www = ($$rlp{nonneg}) ? map { "abs(".$_.")" } @weights : @weights;
    $command .= "# $this is $groups{$this}->{label}\n";
    if ($$rlp{100}) {
      $command .= "def w$last = max(0, 1 - (" . join("+", @weights) . "))\n";
    } else {
      $command .= "guess ww$last = " . $$rlp{"value$last"} . "\n";
      $command .= "def w$last = max(0,min(ww$last,1))\n";
    };
    $command .= "def l___cf.$last = w$last*$this.chi*$this.k^$kw\n";
    push @{ $$rlp{deflist} }, "l___cf.$last", "w$last";
    $define  .= " l___cf.$last";
  } else {
    $define =~ s/\+\s*$//;
  };

  $define  .= "\n";
  $command .= $define;

  ## def the residual array and minimize
  my ($kmin, $kmax) = ($$rlp{fitmin}, $$rlp{fitmax});
  ($kmax = $smallest_kmax - 0.01) if ($kmax > $smallest_kmax);
  $$rlp{fitmax} = $kmax;
  ##$command .= "def l___cf.resid = l___cf.mix - $group.chi*$group.k^$kw\n";
  $command .= "def l___cf.resid = l___cf.mix - l___cf.data\n";
  push @{ $$rlp{deflist} }, "l___cf.resid";
  $command .= "minimize(l___cf.resid, x=$group.k, xmin=$kmin, xmax=$kmax)\n";
  $groups{$current}->dispose($command, $dmode);
#  if ($$rlp{nonneg}) {
#    foreach my $w (@weights, "w$last") {
#      $groups{$current}->dispose("set $w = abs($w)\n", $dmode);
#    };
#  };

  ## store the fit results in the object
  $$rlp{fit_status} = lcf_values($rlp);
  $groups{$current}->MAKE(lcf_fit	 => 1,
			  lcf_fitspace	 => 'k',
			  lcf_fit_status => $$rlp{fit_status},
			  lcf_linear	 => $$rlp{linear},
			  lcf_nonneg	 => $$rlp{nonneg},
			  lcf_100	 => $$rlp{100},
			  lcf_e0all	 => $$rlp{e0all},
			  lcf_slope	 => $$rlp{slope},
			  lcf_yint	 => $$rlp{yint},
			  lcf_kw	 => $$rlp{kw},
			  lcf_fitmin	 => $$rlp{fitmin},
			  lcf_fitmax	 => $$rlp{fitmax},);
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $groups{$current}->MAKE("lcf_standard$i"     => $$rlp{"standard$i"});
    next if ($$rlp{"standard$i"} eq 'None');
    $groups{$current}->MAKE("lcf_standard_lab$i" => $$rlp{"standard_lab$i"},
			    "lcf_value$i"        => $$rlp{"value$i"},
			    "lcf_delta_value$i"  => $$rlp{"delta_value$i"},
			   );
  };
  project_state(0);

  ## write a report to the text box
  lcf_statistics($rlp);
  lcf_results($rlp) if ($plot);
  my $last_error = 0;

  lcf_undef($rlp);
  lcf_plot_k($rlp) if ($plot);

  ## and finish up
  $widget{lcf_operations} -> entryconfigure(4, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(8, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(9, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(7, -state=>'normal', -style=>$$rlp{normal_style});
  Echo("Linear combination fitting $groups{$current}->{label} in chi(k) ... done!");
  $top -> Unbusy;
};


sub lcf_values {
  my $rlp = $_[0];
  my $last_error = 0;
  my $j = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$rlp{"standard$i"} eq 'None');
    ++$j;
    $$rlp{"value$i"} = sprintf("%.3f", Ifeffit::get_scalar("w$i"));
    my $thiserr;
    if ($$rlp{nstandards} == 1) {
      if ($$rlp{nonneg}) {
	$thiserr = Ifeffit::get_scalar("delta_ww".$$rlp{nstandards});
      } else {
	$thiserr = Ifeffit::get_scalar("delta_w".$$rlp{nstandards});
      };
    } elsif ($j eq $$rlp{nstandards}) {
      if ($$rlp{100}) {
	$thiserr = sqrt($last_error);
      } else {
	if ($$rlp{nonneg}) {
	  $thiserr = Ifeffit::get_scalar("delta_ww".$$rlp{nstandards});
	} else {
	  $thiserr = Ifeffit::get_scalar("delta_w".$$rlp{nstandards});
	};
      };
    } else {
      if ($$rlp{nonneg}) {
	$last_error += Ifeffit::get_scalar("delta_ww$i")**2;
	$thiserr = Ifeffit::get_scalar("delta_ww$i");
      } else {
	$last_error += Ifeffit::get_scalar("delta_w$i")**2;
	$thiserr = Ifeffit::get_scalar("delta_w$i");
      };
    };
    $$rlp{"delta_value$i"} = $thiserr;
  };

  unless ($$rlp{fitspace} eq 'k') {
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next if ($$rlp{"standard$i"} eq 'None');
      $$rlp{"e0val$i"} = sprintf("%.3f", Ifeffit::get_scalar("e$i"));
      $$rlp{"delta_e0val$i"} = sprintf("%.3f", Ifeffit::get_scalar("delta_e$i"));
    };

    if ($$rlp{linear}) {
      $$rlp{slope}       = Ifeffit::get_scalar("slope");
      $$rlp{delta_slope} = Ifeffit::get_scalar("delta_slope");
      $$rlp{yint}        = Ifeffit::get_scalar("yint");
      $$rlp{delta_yint}  = Ifeffit::get_scalar("delta_yint");
    } else {
      $$rlp{slope} = 0;
      $$rlp{delta_slope} = 0;
      $$rlp{yint}  = 0;
      $$rlp{delta_yint}  = 0;
    };
  };


  return Ifeffit::get_scalar('&status');
};


sub lcf_undef {
  my $rlp = $_[0];
  $groups{$current}->dispose("## best not to leave defs lying around...", $dmode);
  foreach (@{ $$rlp{deflist} }) {
    $groups{$current}->dispose("set $_ = $_", $dmode);
  };
  $$rlp{deflist} = ();
};

sub lcf_plot {
  my $rlp = $_[0];
  if ($$rlp{fitspace} eq 'k') {
    $$rlp{fitmin_k} = $$rlp{fitmin};
    $$rlp{fitmax_k} = $$rlp{fitmax};
  } else {
    $$rlp{fitmin_e} = $$rlp{fitmin};
    $$rlp{fitmax_e} = $$rlp{fitmax};
  };
  lcf_plot_k($rlp), return if ($$rlp{fitspace} eq 'k');
  lcf_plot_e($rlp);
};

sub lcf_plot_e {
  my $rlp = $_[0];
  Error("\"$groups{$current}->{label}\" cannot be plotted in energy."),
    return if ($groups{$current}->{is_chi} or
	       $groups{$current}->{is_rsp} or
	       $groups{$current}->{is_qsp});
  my $how = ($$rlp{fitspace} eq 'e') ? 'norm(E)' : 'deriv(E)';
  Echo("Plotting $groups{$current}->{label} + linear combination as $how ... ");
  $top -> Busy;
  my $linear = (($$rlp{slope} != 0) or ($$rlp{yint} != 0));
  my $group = $groups{$current}->{group};
  my $yoff  = $groups{$current}->{plot_yoffset};
  $groups{$current}->dispose("## Plotting linear combination of spectra as $how\n", $dmode);
  #($command .= "step $group.energy $groups{$current}->{bkg_e0} $group.theta\n")
  #  if $linear;

  lcf_arrays_e();

  ## plot 'em up
  $how = ($$rlp{fitspace} eq 'e') ? 'emn' : 'emnd';
  $groups{$current}->plotE($how, $dmode, \%plot_features, \@indicator);
  #$groups{$current}->dispose($command, $dmode);
  my $color = $config{plot}{'c1'};
  my $c = 1;
  if ($$rlp{noise} > 0 ) {
    $groups{$current}->dispose("plot(l___cf.energy, \"l___cf.data+$yoff\", key=\"data+noise\", style=lines, color=$color)\n", $dmode);
    $color = $config{plot}{'c2'};
    ++$c;
  };
  $groups{$current}->dispose("plot(l___cf.energy, \"l___cf.mix+$yoff\", key=\"linear combo.\", style=lines, color=$color)\n", $dmode);
  if ($$rlp{difference}) {
    ++$c;
    my $color = $config{plot}{'c'.$c};
    my $key = 'difference';
    $groups{$current}->dispose("plot(l___cf.energy, \"l___cf.diff+$yoff\", key=\"$key\", style=lines, color=$color)\n", $dmode);
  };

  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  $groups{$current}->dispose("set l___cf.x = $current.energy+$groups{$current}->{bkg_eshift}", $dmode);
  if ($$rlp{fitspace} eq 'd') {
    $groups{$current}->dispose("set l___cf.y = deriv($current.norm)/deriv($current.energy)+$groups{$current}->{plot_yoffset}", $dmode);
  } else {
    $groups{$current}->dispose("set l___cf.y = $current.$suff+$groups{$current}->{plot_yoffset}", $dmode);
  };
  my @x = Ifeffit::get_array("l___cf.x");
  my @y = Ifeffit::get_array("l___cf.y");
  my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});
  my $offset = 0;
  if ($$rlp{components}) {
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next if ($$rlp{"standard$i"} eq 'None');
      ++$c;
      my $color = $config{plot}{'c'.$c};
      ($offset   = sprintf("%.4f", abs(($ymin-$yoff)*0.5*$c))) if ($$rlp{fitspace} eq 'd');
      my $key   = $groups{$$rlp{"standard$i"}}->{label};
      $groups{$current}->dispose("plot(l___cf.energy, \"l___cf.$i-$offset+$yoff\", key=\"$key\", style=lines, color=$color)\n", $dmode);
    };
  };

  my ($emin, $emax) = ($$rlp{enot}+$$rlp{fitmin},
		       $$rlp{enot}+$$rlp{fitmax});
  $groups{$current}->plot_vertical_line($emin, $ymin, $ymax, $dmode, "fit range", 0);
  $groups{$current}->plot_vertical_line($emax, $ymin, $ymax, $dmode, "", 0);
  $last_plot='e';
  Echo("Plotting $groups{$current}->{label} + linear combination as norm(E) ... done!");
  $top -> Unbusy;
};


## need to construct l___cf.mix anew...
sub lcf_plot_k {
  Error("\"$groups{$current}->{label}\" cannot be plotted in k."), return if ($groups{$current}->{is_xanes} or
									      $groups{$current}->{is_rsp}   or
									      $groups{$current}->{is_qsp});
  Echo("Plotting $groups{$current}->{label} + linear combination as chi(k) ... ");
  $groups{$current}->dispose("## Plotting linear combination of spectra as chi(k)\n", $dmode);
  my $rlp = $_[0];
  my $group = $groups{$current}->{group};
  my $yoff  = $groups{$current}->{plot_yoffset};
  my ($kmin, $kmax) = ($$rlp{fitmin}, $$rlp{fitmax});
  $groups{$current}->plotk('kw', $dmode, \%plot_features, \@indicator);
  lcf_arrays_k(0);

  my $color = $config{plot}{'c1'};
  my $c = 1;
  if ($$rlp{noise} > 0 ) {
    $groups{$current}->dispose("plot($group.k, \"l___cf.data+$yoff\", key=\"data+noise\", style=lines, color=$color)\n", $dmode);
    $color = $config{plot}{'c2'};
    ++$c;
  };

  $groups{$current}->dispose("plot($group.k, \"l___cf.mix+$yoff\", key=\"linear combo.\", style=lines, color=$color)\n", $dmode);
  my @x = Ifeffit::get_array("$group.k");
  ##$groups{$current}->dispose("set l___cf.y = $group.chi * $group.k**$groups{$current}->{fft_kw}");
  $groups{$current}->dispose("set l___cf.y = $group.chi * $group.k**$plot_features{kw}", $dmode);
  my @y = Ifeffit::get_array("l___cf.y");
  my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'k', 0);
  $ymin = $ymin*1.05 + $yoff;
  $ymax = $ymax*1.05 + $yoff;
  my $offset = 0;
  if ($$rlp{difference}) {
    ++$c;
    my $color = $config{plot}{'c'.$c};
    my $key = 'difference';
    $offset = sprintf("%.4f", abs(($ymin-$yoff)*0.5*$c));
    $groups{$current}->dispose("plot($group.k, \"l___cf.resid-$offset+$yoff\", key=\"$key\", style=lines, color=$color)\n", $dmode);
  };
  if ($$rlp{components}) {
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next if ($$rlp{"standard$i"} eq 'None');
      ++$c;
      my $color = $config{plot}{'c'.$c};
      my $key = $groups{$$rlp{"standard$i"}}->{label};
      $offset = sprintf("%.4f", abs(($ymin-$yoff)*0.5*$c));
      $groups{$current}->dispose("plot($group.k, \"l___cf.$i-$offset+$yoff\", key=\"$key\", style=lines, color=$color)\n", $dmode);
    };
  };
  $ymin = ($offset) ? $yoff - abs(($ymin-$yoff)*0.6*$c) : $ymin;
  $groups{$current}->plot_vertical_line($kmin, $ymin, $ymax, $dmode, "fit range", 0);
  $groups{$current}->plot_vertical_line($kmax, $ymin, $ymax, $dmode, "", 0);
  $last_plot='k';
  Echo("Plotting $groups{$current}->{label} + linear combination as chi(k) ... done!");
};


sub lcf_plot_r {
  Echo("Plotting $groups{$current}->{label} + linear combination as |chi(R)| ... ");
  $groups{$current}->dispose("## Plotting linear combination of spectra as |chi(R)|\n", $dmode);
  my $rlp = $_[0];
  my $group = $groups{$current}->{group};
  my $yoff  = $groups{$current}->{plot_yoffset};
  my ($kmin, $kmax) = ($$rlp{fitmin}, $$rlp{fitmax});
  $groups{$current}->plotR('rm', $dmode, \%plot_features, \@indicator);
  lcf_arrays_k(0);
  my $command = "(l___cf.mix, ";
  $command   .= "k=$current.k, ",
  $command   .= "kweight=0, ";
  $command   .= "kmin=$groups{$current}->{fft_kmin}, ";
  $command   .= "kmax=$groups{$current}->{fft_kmax}, ";
  $command   .= "dk=$groups{$current}->{fft_dk}, ";
  $command   .= "kwindow=$groups{$current}->{fft_win}, ";
  $command   .= "group=l___cf, ";
  $command   .= "rmax_out=$Ifeffit::Group::rmax_out";
  if (lc($groups{$current}->{fft_pc}) eq 'on') {
    my $str = join(" ", lc($groups{$current}->{bkg_z}), lc($groups{$current}->{fft_edge}));
    ($command .= ", pc_edge=\"$str\", pc_caps=1");
  };
  $command   .= ")\n";
  $command    = wrap("fftf", "     ", $command);
  my $color   = $config{plot}{'c1'};
  $command   .= "plot(l___cf.r, \"l___cf.chir_mag+$yoff\", key=\"linear combo.\", style=lines, color=$color)\n";
  $groups{$current}->dispose($command, $dmode);
};


sub lcf_arrays_e {
  my $just_data = $_[0];
  my $group  = $groups{$current}->{group};
  my $eshift = $groups{$current}->{bkg_eshift};

  my $command .= "## Making arrays for fit in energy to $groups{$current}->{label}\n";

  ## find longest common energy range in the marked groups.
  ## interpolate over this range.  intrpolating just over the range of
  ## the first group might lead to extrapolation in other groups.
  my @ee = Ifeffit::get_array("$group.energy");
  my ($emin, $emax) = ($ee[0]+$eshift, $ee[-1]+$eshift);
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    my $this = $$hash_pointer{"standard$i"};
    my $esh  = sprintf("%.3f",$groups{$this}->{bkg_eshift});
    @ee = Ifeffit::get_array("$this.energy");
    my ($e1, $e2) = ($ee[0]+$esh, $ee[-1]+$esh);
    ($emin = $e1) if ($e1 > $emin);
    ($emax = $e2) if ($e2 < $emax);
  };

  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  ($suff = 'norm') if ($$hash_pointer{fitspace} eq 'd');
  my $function = ($$hash_pointer{fitspace} eq 'd') ? "deriv($group.$suff)/deriv($group.energy)" : "$group.$suff";
  if ($config{linearcombo}{energy} eq 'data') {
    $groups{$current}->dispose("set l___cf.eee = $group.energy+$eshift\n", $dmode);
    my @earray = Ifeffit::get_array("l___cf.eee");
    @earray = grep {($_ > $emin) and ($_ < $emax)} @earray;
    Ifeffit::put_array("l___cf.energy", \@earray);
    $command .= "set l___cf_npts = npts(l___cf.energy)\n";
    if ($$hash_pointer{noise} > 0) {
      $command .= "random(output=l___cf.noise, npts=l___cf_npts, dist=normal, sigma=$$hash_pointer{noise})\n"
	if $$hash_pointer{fitting}; # only regenerate noise for a new fit
      $command .= "set l___cf.data = splint(l___cf.eee, $function, l___cf.energy) + l___cf.noise\n";
    } else {
      $command .= "set l___cf.data = splint(l___cf.eee, $function, l___cf.energy)\n";
    };
  } else {
    my @en = Ifeffit::get_array("$group.energy");
    ##my ($emin, $emax) = ($en[0]+$eshift, $en[-1]+$eshift);
    $command .= "set l___cf.energy = range($emin, $emax, $config{linearcombo}{grid})\n";
    $command .= "set l___cf_npts = npts(l___cf.energy)\n";
    $command .= "set l___cf.eee = $group.energy+$eshift\n";
    if ($$hash_pointer{noise} > 0) {
      $command .= "random(output=l___cf.noise, npts=l___cf_npts, dist=normal, sigma=$$hash_pointer{noise})\n"
	if $$hash_pointer{fitting};
      $command .= "set l___cf.data = splint(l___cf.eee, $function, l___cf.energy) + l___cf.noise\n";
    } else {
      $command .= "set l___cf.data = splint(l___cf.eee, $function, l___cf.energy)\n";
    };
  };

  unless ($just_data) {
    $command .= "set l___cf.mix = zeros(l___cf_npts)\n";
    ## interpolate each standard onto the grid of the unknown, apply the
    ## appropriate weight and e0 shift
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next if ($$hash_pointer{"standard$i"} eq 'None');
      my $w = $$hash_pointer{"value$i"};
      my $this = $$hash_pointer{"standard$i"};
      my $e = $$hash_pointer{"e0val$i"};
      my $esh  = sprintf("%.3f",$groups{$this}->{bkg_eshift});
      my $suff = ($groups{$this}->{bkg_flatten}) ? 'flat' : 'norm';
      ($suff = 'norm') if ($$hash_pointer{fitspace} eq 'd');
      $groups{$this}->dispatch_bkg($dmode) if $groups{$this}->{update_bkg};
      my $function = ($$hash_pointer{fitspace} eq 'd') ? "deriv($this.$suff)/deriv($this.energy)" : "$this.$suff";
      $command .= "set l___cf.$i = $w*splint($this.energy+$esh+$e, $function, l___cf.energy)\n";
      $command .= "set l___cf.mix = l___cf.mix + l___cf.$i\n";
    };
    ## add on a linear offset, if appropriate
    if ($$hash_pointer{linear}) {
      $command .= "set l___cf.line = l___cf.theta*($$hash_pointer{slope}*($$hash_pointer{yint} + l___cf.energy-$$hash_pointer{enot}))\n";
      $command .= "set l___cf.mix  = l___cf.mix + l___cf.line\n";
    };
    $command .= "set l___cf.diff = l___cf.data - l___cf.mix\n";
  };

  $groups{$current}->dispose($command, $dmode);
};

sub lcf_arrays_k {
  my $just_data = $_[0];
  my $group = $groups{$current}->{group};
  ##my $kw    = $groups{$current}->{fft_kw};
  my $kw    = $plot_features{kw};
  my $command .= "## Making arrays for fit in k to $groups{$current}->{label}\n";
  $command    .= "set l___cf_npts = npts($group.k)\n";
  if ($$hash_pointer{noise} > 0) {
    $command .= "random(output=l___cf.noise, npts=l___cf_npts, dist=normal, sigma=$$hash_pointer{noise})\n";
    my $function = "($group.chi+l___cf.noise)*$group.k^$kw";
    $command .= "set l___cf.data = $function + l___cf.noise\n";
  } else {
    my $function = "$group.chi*$group.k^$kw";
    $command .= "set l___cf.data = $function\n";
  };
  unless ($just_data) {
    $command   .= "set l___cf.mix = zeros(l___cf_npts)\n";
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next if ($$hash_pointer{"standard$i"} eq 'None');
      my $this  = $$hash_pointer{"standard$i"};
      my $value = $$hash_pointer{'value'.$i};
      my $key = $groups{$$hash_pointer{"standard$i"}}->{label};
      $groups{$this} -> dispatch_bkg($dmode) if ($groups{$this}->{update_bkg});
      ##$command .= "set l___cf.$i = $value*$this.chi*$this.k**$groups{$current}->{fft_kw}\n";
      $command .= "set l___cf.$i = $value*$this.chi*$this.k**$plot_features{kw}\n";
      $command .= "set l___cf.mix = l___cf.mix + l___cf.$i\n";
      #$groups{$current}->dispose($command, $dmode);
    };
    $command .= "set l___cf.diff = l___cf.resid\n";
  };
  $groups{$current}->dispose($command, $dmode);
};

sub lcf_use_marked {
  my $rlp = $_[0];
  my $count = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    $$rlp{"standard$i"}     = 'None';
    $$rlp{"standard_lab$i"} = '0: None';
    $$rlp{"value$i"}        = 0;
    $$rlp{"delta_value$i"}  = 0;
    $$rlp{"e0val$i"}        = 0;
    $$rlp{"delta_e0val$i"}  = 0;
  };
 MG: foreach my $k (&sorted_group_list) {
    next MG unless $marked{$k};
    next if ($k eq $current);
    ## need to make sure that the record type is appropriate for this fit
    next MG if $groups{$k}->{is_rsp};
    next MG if $groups{$k}->{is_qsp};
    next MG if $groups{$k}->{not_data};
    if ($$rlp{fitspace} eq 'k') {
      next MG if $groups{$k}->{is_xanes};
    } else {
      next MG if $groups{$k}->{is_chi};
    };
    ++$count;
    next if ($count > $config{linearcombo}{maxspectra});
    $$rlp{"standard$count"}     = $k;
    $$rlp{"standard_lab$count"} = $groups{$k}->{lcf_menu_label};
    $groups{$current} -> MAKE("lcf_standard$count"     => $k,
			      "lcf_standard_lab$count" => $groups{$k}->{lcf_menu_label});
  };
  lcf_initialize($rlp, 2);
};

sub lcf_results {
  my $rlp = $_[0];
  my $bg = $config{colors}{background};
  $widget{lcf_maxfit} -> configure(-foreground=>'black',
				   -background=>$bg,
				   -text=>"") unless $$rlp{doing_combinatorics};
  ## deal with project files from older versions of Athena's LCF dialog
  map {$groups{$current}->{"lcf_$_"} ||= 0} (qw(sumsqr rfact chisqr chinu nvarys ndata kw));

  my $last_error = 0;
  my $how = "";
 SWITCH: {
    ($how = 'norm(E)'),  last SWITCH if ($groups{$current}->{lcf_fitspace} eq 'e');
    ($how = 'deriv(E)'), last SWITCH if ($groups{$current}->{lcf_fitspace} eq 'd');
    ($how = 'chi(k)'),   last SWITCH if ($groups{$current}->{lcf_fitspace} eq 'k');
  };
  my $report = sprintf("Fitting %s as $how from %.3f to %.3f\n", $groups{$current}->{label}, $groups{$current}->{lcf_fitmin}, $groups{$current}->{lcf_fitmax});
  $report   .= "   fit done use k-weight = $groups{$current}->{lcf_kw}\n" if ($groups{$current}->{lcf_fitspace} eq 'k');
  $report   .= "\n";

  my $variables = ($groups{$current}->{lcf_nvarys} > 1) ? 'variables' : 'variable';
  $report   .= "Fit included $groups{$current}->{lcf_ndata} data points and $groups{$current}->{lcf_nvarys} $variables\n";
  $report   .= sprintf("R-factor = %.6f\nchi-square = %.5f\nreduced chi-square = %.7f\n\n",
		       $groups{$current}->{lcf_rfact},
		       $groups{$current}->{lcf_chisqr},
		       $groups{$current}->{lcf_chinu}
		      );

  if ($groups{$current}->{lcf_sumsqr} == 1) {$report .= "Uh oh! something went wrong with the sum of squares...\n"};

  $report   .= "   group                weight\n";
  $report   .= "=======================================\n";
  my $is_neg = 0;
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next unless (exists $groups{$current}->{"lcf_standard$i"});
    next if ($groups{$current}->{"lcf_standard$i"} eq 'None');
    $groups{$current}->{"lcf_value$i"}       ||= 0;
    $groups{$current}->{"lcf_delta_value$i"} ||= 0;
    $report .= sprintf("  %-20s  %5.3f(%5.3f)\n",
		       $groups{$current}->{"lcf_standard_lab$i"},
		       $groups{$current}->{"lcf_value$i"},
		       $groups{$current}->{"lcf_delta_value$i"},);
    ++$is_neg if ($groups{$current}->{"lcf_value$i"} < 0 );
  };

  unless ($groups{$current}->{lcf_fitspace} eq 'k') {
    $report   .= "\n\n   group                e0 shift\n";
    $report   .= "=======================================\n";
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      next unless (exists $groups{$current}->{"lcf_standard$i"});
      next if ($groups{$current}->{"lcf_standard$i"} eq 'None');
      $groups{$current}->{"lcf_e0val$i"}       ||= 0;
      $groups{$current}->{"lcf_delta_e0val$i"} ||= 0;
      $report .= sprintf("  %-20s %6.3f(%6.3f)\n",
			 $groups{$current}->{"lcf_standard_lab$i"},
			 $groups{$current}->{"lcf_e0val$i"},
			 $groups{$current}->{"lcf_delta_e0val$i"},
			);
    };

    if ($groups{$current}->{lcf_linear}) {
      $report .= sprintf("\n\n with linear term %.3f(%.3f) + %.3g(%.3g) * (E-E0)\n",
			 $groups{$current}->{lcf_yint},
			 $groups{$current}->{lcf_delta_yint},
			 $groups{$current}->{lcf_slope},
			 $groups{$current}->{lcf_delta_slope},)
    };
  };
  $widget{lcf_text} -> delete('1.0', 'end');
  $widget{lcf_text} -> insert('end', $report, 'text');

  ## error handling

  my $red = $config{colors}{single};
  $groups{$current}->{lcf_fit_status} ||= 0;
  if ($groups{$current}->{lcf_fit_status} == 2) {	# error bars not calculated
    $widget{lcf_maxfit} -> configure(-foreground=>$red,
				     -background=>'white',
				     -text=>"Fit returned a warning!") unless $$rlp{doing_combinatorics};
    my $addendum = "
This fit flagged a warning -- probably that error bars
could not be calculated.  That is probably an indication
that one or more of your standards are innapropriate for
this fit.

";
    $widget{lcf_text} -> insert('end', $/);
    $widget{lcf_text} -> insert('end', $addendum, 'error');

  } elsif ($groups{$current}->{lcf_fit_status} > 2) { # something bad!
    $widget{lcf_maxfit} -> configure(-foreground=>$red,
				     -background=>'white',
				     -text=>"Fit returned an error!") unless $$rlp{doing_combinatorics};
    my $addendum = "
This fit flagged a error.  You will need to check the
Ifeffit buffer for details.  One possible cause is that
the standards are inappropriate for this fit and that
the maximum number of iterations in the fit was exceeded.

";
    $widget{lcf_text} -> insert('end', $/);
    $widget{lcf_text} -> insert('end', $addendum, 'error');
  };

  if ($groups{$current}->{lcf_100} and $groups{$current}->{lcf_nonneg} and $is_neg) {
    $widget{lcf_maxfit} -> configure(-foreground=>$red,
				     -background=>'white',
				     -text=>"Poorly constrained fit!") unless $$rlp{doing_combinatorics};
    my $addendum = "
This fit yielded a negative weight.  One or more
of your standards are innapropriate for this fit
and should be removed from the list.

";
    $widget{lcf_text} -> insert('end', $/);
    $widget{lcf_text} -> insert('end', $addendum, 'error');
  };

};

## prompt for a filename and write the report from the text box to
## that file
sub lcf_report {
  my $path = $current_data_dir || Cwd::cwd;
  my $f = $groups{$current}->{label} . ".lcf";
  $f =~ s/ /_/g;
  my $types = [['Linear combination fits', '.lcf'], ['All files', '*']];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$f,
				 -title => "Athena: Write linear combination fitting report");
  Echo("Not writing linear combination fit report"), return unless $file;

  open F, ">".$file;
  foreach (split "\n", $widget{lcf_text}->get('1.0', 'end')) {
    print F "# ", $_, $/;
  };
  print F "# ", "-" x 40, $/;
  my $x = ($$hash_pointer{fitspace} eq 'k') ? "k" : "energy";
  print F "# ", " $x     data      fit    residual";
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    my $label = $groups{$$hash_pointer{"standard$i"}}->{label};
    $label =~ s/\s+/_/g;
    print F "    ", $label;
  };
  print F $/;

  if ($$hash_pointer{fitspace} eq 'k') {
    lcf_arrays_k(0);
  } else {
    lcf_arrays_e(0);
  };

  my $group = $groups{$current}->{group};
  ## not flat, k-weight
  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  ($suff = 'norm') if ($$hash_pointer{fitspace} eq 'd');
  ($suff = 'chi')  if ($$hash_pointer{fitspace} eq 'k');
  my @x = Ifeffit::get_array("$group.$x");
  unless ($$hash_pointer{fitspace} eq 'k') {
    @x = Ifeffit::get_array("l___cf.energy");
  };
  my @data;
  if ($$hash_pointer{fitspace} eq 'd') {
    ##$groups{$current}->dispose("t___oss.y = deriv($group.$suff)/deriv($group.energy)\n", 1);
    $groups{$current}->dispose("t___oss.y = deriv(l___cf.data)/deriv(l___cf.energy)\n", 1);
    @data = Ifeffit::get_array("t___oss.y");
    $groups{$current}->dispose("erase t___oss.y\n", 1);
  } else {
    ##@data = Ifeffit::get_array("$group.$suff");
    @data = Ifeffit::get_array("l___cf.data");
  };
  my @fit   = Ifeffit::get_array("l___cf.mix");
  my @diff  = Ifeffit::get_array("l___cf.diff");
  my @components = ();
  foreach  my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    my @this = Ifeffit::get_array("l___cf.$i");
    $components[$i] = \@this;
  };
  my $kw = -1 * $$hash_pointer{kw};	# remove the k-weighting from the fit
  foreach my $i (0 .. $#x) {
    if ($$hash_pointer{fitspace} eq 'k') {
      next if ($i==0);
      printf F "  %.3f   %.5f   %.5f   %.5f", $x[$i], $data[$i], $fit[$i]*$x[$i]**$kw, $diff[$i]*$x[$i]**$kw;
      foreach my $j (1 .. $config{linearcombo}{maxspectra}) {
	next if ($$hash_pointer{"standard$j"} eq 'None');
	printf F "   %.5f", $components[$j]->[$i]*$x[$i]**$kw;
      };
      print  F $/;
    } else {
      printf F "  %.3f   %.5f   %.5f   %.5f", $x[$i], $data[$i], $fit[$i], $diff[$i];
      foreach my $j (1 .. $config{linearcombo}{maxspectra}) {
	next if ($$hash_pointer{"standard$j"} eq 'None');
	printf F "   %.5f", $components[$j]->[$i];
      };
      print  F $/;
    };
  };
  close F;
  Echo("Wrote linear combination fit report to \"$file\"");
};

sub lcf_marked_report {
  ## write the header information
  my $how = "";
 SWITCH: {
    ($how = 'norm(E)'),  last SWITCH if ($$hash_pointer{fitspace} eq 'e');
    ($how = 'deriv(E)'), last SWITCH if ($$hash_pointer{fitspace} eq 'd');
    ($how = 'chi(k)'),   last SWITCH if ($$hash_pointer{fitspace} eq 'k');
  };
  my $head = $groups{$current} -> project_header;
  $head   =~ s/,/ /g;
  $head   .= "# Linear combination fits to marked groups as $how$/";
  $head   .= "#    fit done use k-weight = $$hash_pointer{kw}$/" if ($$hash_pointer{fitspace} eq 'k');
  $head   .= "#    noise level: $$hash_pointer{noise}$/";
  $head   .= "#    values between 0 and 1: ";
  $head   .= ($$hash_pointer{nonneg}) ? "yes" : "no";
  $head   .= "$/";
  $head   .= "#    values sum to 1: ";
  $head   .= ($$hash_pointer{100}) ? "yes" : "no";
  $head   .= "$/";
  $head =~ s/^\#/\#,/g;

  open F, ">".$groups{"Default Parameters"} -> find('athena', 'temp_lcf');
  print F $head;

  ## write the column labels for the standards
  print F ",,,,,,,";
  foreach my $i (1..$config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    print F ",", $$hash_pointer{"standard_lab$i"}, ",,,";
  };
  print F ",linear term,,,";
  print F $/;

  ## write the column labels for the parameters
  print F "Group,R-factor,chi square,chi nu,nvar,ndata,fit min,fit max",
    ",value,+/-,e shift,+/-" x $$hash_pointer{nstandards},
      ",slope,+/-,y-intercept,+/-",
	$/;

  ## loop through the marked groups
  foreach my $g (&sorted_group_list) {
    next unless $marked{$g};
    my $is_ok = 1;
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      $is_ok = 0 if ($g eq $$hash_pointer{"standard$i"});
    };
    next unless $is_ok;
    (my $label = $groups{$g}->{label}) =~ s/,//g;
    print F join(",",
		 $label,
		 $groups{$g}->{lcf_rfact},
		 $groups{$g}->{lcf_chisqr},
		 $groups{$g}->{lcf_chinu},
		 $groups{$g}->{lcf_nvarys},
		 $groups{$g}->{lcf_ndata},
		 $groups{$g}->{lcf_fitmin},
		 $groups{$g}->{lcf_fitmax},
		);
    foreach my $i (1..$config{linearcombo}{maxspectra}) {
      next if ($$hash_pointer{"standard$i"} eq 'None');
      print F join(",", q{},
		   $groups{$g}->{"lcf_value$i"},
		   $groups{$g}->{"lcf_delta_value$i"});
      if ($$hash_pointer{fitspace} eq 'k') {
	print F ",0,0";
      } else {
	print F join(",", q{},
		     $groups{$g}->{"lcf_e0val$i"},
		     $groups{$g}->{"lcf_delta_e0val$i"});
      };
    };
    if ($$hash_pointer{fitspace} eq 'k') {
      print F ",0,0,0,0";
    } else {
      print F join(",", q{},
		   $groups{$g}->{"lcf_slope"},
		   $groups{$g}->{"lcf_delta_slope"},
		   $groups{$g}->{"lcf_yint"},
		   $groups{$g}->{"lcf_delta_yint"},
		  );
    };
    print F $/;
  };
  close F;
};

sub lcf_save_marked_report {
  Error("You have not made a marked groups fit!"), return unless (-e $groups{"Default Parameters"}->find('athena', 'temp_lcf'));
  my $path = $current_data_dir || Cwd::cwd;
  my $f = "lcf_marked.csv";
  my $types = [['Comma separated values', '.csv'], ['All files', '*']];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$f,
				 -title => "Athena: Write marked groups fitting report");
  Echo("Not writing marked groups fit report"), return unless $file;
  copy($groups{"Default Parameters"}->find('athena', 'temp_lcf'), $file);
  Echo("Saved marked fit report as \"$file\"");
};

sub lcf_csv_report {

  my $path = $current_data_dir || Cwd::cwd;
  my $f = $groups{$current}->{label} . "_lcf.csv";
  $f =~ s/ /_/g;
  my $types = [['Comma separated values', '.csv'], ['All files', '*']];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$f,
				 -title => "Athena: Write linear combination fitting report");
  Echo("Not writing linear combination fit report"), return unless $file;

  my @order  = $widget{lcf_result_table}->info('children');
  my @labels = map {$groups{$_}->{label}} @order;
  push(@labels, 'linear term') if ($$hash_pointer{linear});

  my $how = "";
 SWITCH: {
    ($how = 'norm(E)'),  last SWITCH if ($$hash_pointer{fitspace} eq 'e');
    ($how = 'deriv(E)'), last SWITCH if ($$hash_pointer{fitspace} eq 'd');
    ($how = 'chi(k)'),   last SWITCH if ($$hash_pointer{fitspace} eq 'k');
  };
  my $head = $groups{$current} -> project_header;
  $head   =~ s/,/ /g;
  $head   .= sprintf("# Linear combination fits to %s as $how\n", $groups{$current}->{label});
  $head   .= "#    fit done use k-weight = $$hash_pointer{kw}\n" if ($$hash_pointer{fitspace} eq 'k');

  open F, ">".$file;
  print F $head;
  print F "," x 13, join(",,,,", @labels), $/;
  my $n = $#labels+1;
  print F "R-factor,chisqr,chinu,fit_status,Nvar,Ndata,fit_min,fit_max,,y_intercept,delta_y_intercept,slope,delta_slope" .
    ",weight,delta_weight,e0,delta_e0" x $n . $/;

  my @all = $widget{lcf_select_table}->info('children');
  foreach my $i (@all) {
    $widget{lcf_select_table} -> selectionClear;
    $widget{lcf_select_table} -> selectionSet($i);
    my $data = $widget{lcf_select_table}->info('data', $i);
    $data =~ s/^[^\|]*\|//;
    $data =~ s/\|/,/g;
    print F $data, $/;
  };
  close F;
  $widget{lcf_select_table} -> selectionClear;
  $widget{lcf_select_table} -> selectionSet(0);
  $$hash_pointer{toggle} = 1;
  lcf_fill_result(\@order, $hash_pointer, 1, 0);
  Echo("Wrote linear combination fit report to \"$file\"");
};


## make a new data group out of the best fit function.  make this a
## detector group so it can only be plotted in E
sub lcf_group {
  my $rlp = $_[0];
  my $array = $_[1];
  my $group = $groups{$current}->{group};
  my $name = ($array eq "fit") ? "LCF " : "LCF diff ";
  my ($new, $label) = group_name($name . $groups{$current}->{label});
  $groups{$new} = Ifeffit::Group -> new(group=>$new, label=>$label);
  $groups{$new} -> set_to_another($groups{$group});
  if ($$rlp{fitspace} eq 'k') {
    $groups{$new} -> MAKE(is_xmu => 0, is_chi => 1, is_rsp => 0,
			  is_qsp => 0, is_bkg => 0,
			  not_data => 0,
			  file => $$rlp{filestring});
  } else {
    $groups{$new} -> MAKE(is_xmu => 1, is_chi => 0, is_rsp => 0,
			  is_qsp => 0, is_bkg => 0, is_nor => 1,
			  not_data => 0, bkg_flatten => 0,
			  file => $$rlp{filestring});
    $groups{$new} -> MAKE(bkg_e0 => $groups{$group}->{bkg_e0});
  };
  $groups{$new}->{titles} = [];
  my $text = $widget{lcf_text} -> get(qw(1.0 end));
  ## see refresh_titles for explanation
  foreach (split(/\n/, $text)) {
    next if ($_ =~ /^\s*$/);
    my $count = 0;
    foreach my $i (0..length($_)) {
      ++$count if (substr($_, $i, 1) eq '(');
      --$count if ($count and (substr($_, $i, 1) eq ')'));
    };
    $_ .= ')' x $count;
    push @{$groups{$new}->{titles}}, $_;
  };
  $groups{$new} -> put_titles;
  my $which = ($array eq "fit") ? "mix" : "diff";
  if ($$rlp{fitspace} eq 'k') {
    lcf_arrays_k(0);
    my $kw = -1 * $$rlp{kw};	# remove the k-weighting from the fit
    $groups{$new} -> dispose("set $new.k = $group.k", $dmode);
    $groups{$new} -> dispose("set $new.chi = l___cf.$which*$group.k^$kw", $dmode);
  } else {
    my $was = $$rlp{fitspace};
    $$rlp{fitspace} = 'e';
    lcf_arrays_e(0);
    $$rlp{fitspace} = $was;
    ##$groups{$new} -> dispose("set $new.energy = $group.energy + " . $groups{$group}->{bkg_eshift}, $dmode);
    $groups{$new} -> dispose("set $new.energy = l___cf.energy", $dmode);
    $groups{$new} -> dispose("set $new.xmu = l___cf.$which", $dmode);
  };
  ++$line_count;
  fill_skinny($list, $new, 1, 1);
  my $memory_ok = $groups{$new}
    -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo("WARNING: Ifeffit is out of memory!"), return if ($memory_ok == -1);
  Echo("Saved linear combination fit as a new data group");
};

## restore all the widgets except the optionmenus to their original
## state
sub lcf_reset {
  my $rlp = $_[0];
  my $skip_toggles= $_[1];
  my $bg = $config{colors}{background};
  $widget{lcf_maxfit} -> configure(-foreground=>'black',
				   -background=>$bg,
				   -text=>"") unless $$rlp{doing_combinatorics};
  $groups{$current}->dispose("\n## reseting the LCF parameters:\n");
  $widget{lcf_text}   -> delete(qw(1.0 end));
  unless ($skip_toggles) {
    $widget{lcf_nonneg} -> select;
    $widget{lcf_linear} -> deselect;
    $widget{lcf_100}    -> select;
    $widget{lcf_e0all}  -> deselect;
  };
  lcf_initialize($rlp, 2);
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    unless ($skip_toggles) {
      $$rlp{"e0$i"} = $config{linearcombo}{fite0};
      $$rlp{"e0val$i"} = 0;
    };
    $$rlp{"delta_e0val$i"} = 0;
  };
  $$rlp{req}         = q{};
  $$rlp{slope}       = 0;
  $$rlp{delta_slope} = 0;
  $$rlp{yint}        = 0;
  $$rlp{delta_yint}  = 0;
  $groups{$current}->dispose("unguess\n");
  #$groups{$current}->dispose("erase \@group l___cf\n");
};

sub lcf_pluck{
  my $rlp = $_[0];
  my $which = $_[1];
  my $e0 = $groups{$current}->{bkg_e0};
  my $how = ($$rlp{fitspace} eq 'k') ? 'k' : 'e';
  &pluck("lcf_$which", 0, $how);
  my $e = $widget{"lcf_$which"}->get();
  if      (($$rlp{fitspace} =~ /[ed]/) and ($last_plot eq 'e')) {
    $e = $e-$e0;
  } elsif (($$rlp{fitspace} =~ /[ed]/) and ($last_plot eq 'k')) {
    $e = $groups{$current}->k2e($e);
  } elsif (($$rlp{fitspace} eq 'k')    and ($last_plot eq 'e')) {
    $e = $groups{$current}->e2k($e);
  } elsif (($$rlp{fitspace} eq 'k')    and ($last_plot eq 'k')) {
    1;
  };
  $e = sprintf("%.3f", $e);
  $widget{"lcf_$which"}->delete(0, 'end');
  $widget{"lcf_$which"}->insert(0, $e);
  if ($$rlp{fitspace} eq 'k') {
    my $key = join("_", "lcf", $which, "k");
    $groups{$current}->MAKE($key => $e);
  } else {
    my $key = join("_", "lcf", $which, "e");
    $groups{$current}->MAKE($key => $e);
  };
};

## compute an r-factor and generate a couple of lines containing the
## basic fitting statistics
sub lcf_statistics {
  my $rlp = $_[0];
  my $group = $groups{$current}->{group};
  my ($emin, $emax, @x, @y, @z);
  if ($$rlp{fitspace} eq 'e') {
    my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
    ($emin, $emax) = ($$rlp{enot}+$$rlp{fitmin},
		      $$rlp{enot}+$$rlp{fitmax});
    @x = Ifeffit::get_array("l___cf.energy");
    @z = Ifeffit::get_array("l___cf.data");
  } elsif ($$rlp{fitspace} eq 'd') {
    ($emin, $emax) = ($$rlp{enot}+$$rlp{fitmin},
		      $$rlp{enot}+$$rlp{fitmax});
    @x = Ifeffit::get_array("l___cf.energy");
    @z = Ifeffit::get_array("l___cf.data");
  } else {
    ($emin, $emax) = ($$rlp{fitmin},$$rlp{fitmax});
    @x = Ifeffit::get_array("$group.k");
    @z = Ifeffit::get_array("$group.chi");
  };
  @y = Ifeffit::get_array("l___cf.resid");
  my ($sumsqr, $npts, $rfact) = (0, 0, 0);
  foreach my $i (0 .. $#x) {
    next if $x[$i] < $emin;
    next if $x[$i] > $emax;
    last if $i > $#z;
    ++$npts;
    $rfact += $y[$i]**2;
    if ($$rlp{fitspace} =~ /[ed]/) {
      $sumsqr += $z[$i]**2;
    } else {
      $sumsqr += ($z[$i]*$x[$i]**$$rlp{kw})**2;
    };
  };
  $sumsqr ||= 1;
  $rfact /= $sumsqr;
  $$rlp{sumsqr} = $sumsqr;
  $$rlp{rfact}  = $rfact;
  $$rlp{chisqr} = Ifeffit::get_scalar("chi_square");
  $$rlp{chinu}  = Ifeffit::get_scalar("chi_reduced");
  $$rlp{nvarys} = Ifeffit::get_scalar("n_varys");
  $$rlp{ndata}  = $npts;
  ## also save a group data
  $groups{$current}->{lcf_sumsqr} = $sumsqr;
  $groups{$current}->{lcf_rfact}  = $rfact;
  $groups{$current}->{lcf_chisqr} = Ifeffit::get_scalar("chi_square");
  $groups{$current}->{lcf_chinu}  = Ifeffit::get_scalar("chi_reduced");
  $groups{$current}->{lcf_nvarys} = Ifeffit::get_scalar("n_varys");
  $groups{$current}->{lcf_ndata}  = $npts;
};


sub lcf_combinatorics {
  my $rlp = $_[0];
  Echo("Combinatorial fitting ...");
  if ($$rlp{fitspace} eq 'k') {
    $$rlp{fitmin_k} = $$rlp{fitmin};
    $$rlp{fitmax_k} = $$rlp{fitmax};
  } else {
    $$rlp{fitmin_e} = $$rlp{fitmin};
    $$rlp{fitmax_e} = $$rlp{fitmax};
  };
  my @save = ();
  my @standards = ();
  my @order = ();
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    push(@order,     $$rlp{"standard".$i});
    push(@standards, $$rlp{"standard".$i}) unless ($$rlp{"standard".$i} eq 'None');
    $save[$i] = $$rlp{"standard".$i};
    ##$$rlp{"standard".$i} = 'None';
  };
  my @biglist = ();
  my $req_save = $$rlp{req};
  my $required = ($$rlp{req}) ? $$rlp{"standard".$$rlp{req}} : q{};
  foreach my $n (2 .. $#standards+1) {
    last if ($n > $$rlp{maxstan});
    my $combinat = Math::Combinatorics->new(count => $n,
					    data => \@standards,
					   );
    while (my @combo = $combinat->next_combination) {
      my $stringified = join(" ", @combo);
      ##print ">$required< $stringified\n";
      next if ($required and not ($stringified =~ /$required/));
      push @biglist, \@combo;
    };
  };

  if ($#biglist > 50) {
    my ($n, $ns, $ms) = ($#biglist+1, $#standards+1, $$rlp{maxstan});
    my $message = "You have asked that $n fits be performed ($ns possible standards with each fit using up to $ms of them).  That will take some time.  Do you want to continue?";
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => $message,
		     -title          => 'Athena: Start fitting?',
		     -buttons        => ['Continue', 'Abort'],
		     -default_button => 'Continue',);
    my $response = $dialog->Show();
    Echo("Combinatorial fitting ... aborted!"), return if ($response eq 'Abort');
  };
  $top -> Busy;
  my @results;
  $$rlp{iterator} = 0;
  $$rlp{doing_combinatorics} = 1;
  my $orange = $config{colors}{current};
  my $blue = $config{colors}{activehighlightcolor};
  $widget{lcf_maxfit} -> configure(-foreground=>$blue,
				   -background=>$orange);
  my $nbl = $#biglist + 1;
  tie my $timer, 'Time::Stopwatch';
  foreach my $l (@biglist) {
    #map {print("$groups{$_}->{label} ")} @$l;
    #print $/;

    my $i = 1;
    foreach my $s (@order) {
      if (grep(/$s/, @$l)) {
	$$rlp{"standard".$i} = $s;
	$$rlp{"standard_lab$i"} = $groups{$s}->{lcf_menu_label};
      } else {
	$$rlp{"standard".$i} = 'None';
	$$rlp{"standard_lab$i"} = '0: None';
      };
      ++$i;
    };
    lcf_reset($rlp,1);
    $$rlp{req} = $req_save;
    $top -> update;

    ++$$rlp{iterator};
    $widget{lcf_maxfit} -> configure(-text=>"fit $$rlp{iterator} of $nbl");
    ## run this fit
    lcf_fit($rlp, 0);
    $$rlp{fit_status} = Ifeffit::get_scalar('&status');

    ## store the results of this fit
    my @this = ();
    push @this, join(",", @$l), $$rlp{rfact}, $$rlp{chisqr}, $$rlp{chinu}, $$rlp{fit_status}, $$rlp{nvarys},
      $$rlp{ndata}, $$rlp{fitmin}, $$rlp{fitmax}, 0,
	$$rlp{yint}, $$rlp{delta_yint}, $$rlp{slope}, $$rlp{delta_slope};
    foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
      push @this, $$rlp{"value".$i}, $$rlp{"delta_value".$i}, $$rlp{"e0val".$i}, $$rlp{"delta_e0val".$i};
    };
    push @results, \@this;
  };
  my $elapsed = $timer;
  undef $timer;
  $elapsed = sprintf("%d fits in %.0f min, %.0f sec", $nbl, $elapsed/60, $elapsed%60);
  $$rlp{doing_combinatorics} = 0;
  $$rlp{fit_status} = 0;
  $$rlp{req} = $req_save;
  $groups{$current} -> dispose("set &status = 0\n", $dmode);

  ## sort by increasing R-factor
  @results = sort {$a->[1] <=> $b->[1]} @results;
  $lcf_data{$current}{order}   = \@order;
  $lcf_data{$current}{results} = \@results;
  my $brown = $config{colors}{background};
  $widget{lcf_maxfit} -> configure(-text=>"", -background=>$brown);

  lcf_display();

  $widget{lcf_combo_group} -> configure(-text=>"Fits to \"$groups{$current}->{label}\" with up to $$rlp{maxstan} standards");
  $top -> Unbusy;
  Echo("Combinatorial fitting ... done!  (Displaying and plotting the best fit.) ($elapsed)");
};


sub lcf_display {

  my @results = @{ $lcf_data{$current}{results} };
  my @order   = @{ $lcf_data{$current}{order}   };
  ## need to translate between the integers in the result table and
  ## the groups used in the fit
  my %names;
  $names{$order[$_]} = $_+1 foreach (0 .. $#order);


  ## empty out both tables
  $widget{lcf_select_table}->delete('all');
  $widget{lcf_result_table}->delete('all');
  my $j = 0;
  my $combo_selected = $j;
  ## fill the select table with all these fits
  foreach (@results) {
    $widget{lcf_select_table}->add($j, -data=>join("|", @$_));
    #my @these = split(/,/, $_->[0]);
    #print join(" ", @these, $_->[1]), $/;
    (my $text = $_->[0]) =~ s/([a-z]{4})/$names{$1}/g;
    $text = join(",", sort {$a <=> $b} ( split(/,/, $text))); # sort the indeces
    $widget{lcf_select_table}->itemCreate($j, 0, -itemtype=>'text',   -text=>$text);
    $widget{lcf_select_table}->itemCreate($j, 1, -itemtype=>'text',   -text=>sprintf("%.7g",$_->[1]));
    $widget{lcf_select_table}->itemCreate($j, 2, -itemtype=>'text',   -text=>sprintf("%.7g",$_->[3]));
    ++$j;
  };
  ## fill the results table
  my $k = 1;
  foreach my $s (@order) {
    next if ($s eq 'None');
    $widget{lcf_result_table}->add($s);
    $widget{lcf_result_table}->itemCreate($s, 0, -itemtype=>'text', -text=>$k);
    $widget{lcf_result_table}->itemCreate($s, 1, -itemtype=>'text', -text=>$groups{$s}->{label});
    my $v = 6+4*$k;
    $widget{lcf_result_table}->itemCreate($s, 2, -itemtype=>'text',
					  -text=>sprintf("%.3f (%.3f)", $results[0]->[$v], $results[0]->[$v+1]));
    $widget{lcf_result_table}->itemCreate($s, 3, -itemtype=>'text',
					  -text=>sprintf("%.3f (%.3f)", $results[0]->[$v+2], $results[0]->[$v+3]));
    ++$k;
  };
  if ($$hash_pointer{linear}) {
    $widget{lcf_result_table}->add('linear');
    $widget{lcf_result_table}->itemCreate('linear', 1, -itemtype=>'text', -text=>'linear term');
    $widget{lcf_result_table}->itemCreate('linear', 2, -itemtype=>'text',
					  -text=>sprintf("%.3f (%.3f)", $$hash_pointer{yint}, $$hash_pointer{delta_yint}));
    $widget{lcf_result_table}->itemCreate('linear', 3, -itemtype=>'text',
					  -text=>sprintf("%.6f (%.6f)", $$hash_pointer{slope}, $$hash_pointer{delta_slope}));
  };

  @order  = $widget{lcf_result_table}->info('children');
  $widget{lcf_select_table} -> configure(-browsecmd=>sub{lcf_fill_result(\@order, $hash_pointer, 1)});
  $widget{lcf_select_table} -> selectionSet(0);
  $widget{lcf_select_table} -> anchorSet(0);
  $$hash_pointer{toggle} = 1;
  lcf_fill_result(\@order, $hash_pointer, 1, 0);
  $widget{lcf_combo_group} -> configure(-text=>"Fits to \"$groups{$current}->{label}\"");
  $widget{lcf_notebook} -> pageconfigure('combinatorics', -state=>'normal');
  $widget{lcf_notebook} -> raise('combinatorics');
};

sub lcf_fill_result {
  #print join(" ", @_), $/;
  my ($rorder, $rlp, $plot, $j) = @_;
  $$rlp{toggle} = not $$rlp{toggle};
  return if $$rlp{toggle};	#  only on the release
  $j = $widget{lcf_select_table} -> selectionGet();
  my $data = $widget{lcf_select_table} -> info('data', $j);
  my @list = split(/\|/, $data);
  my $i = 0;
  ##my %local = ();
  foreach my $s (@$rorder) {
    ++$i;
    if ($s eq 'None') {
      $$rlp{"standard$i"}     = 'None';
      $$rlp{"standard_lab$i"} = '0: None';
      $$rlp{"value$i"}        = 0;
      $$rlp{"delta_value$i"}  = 0;
      $$rlp{"e0val$i"}        = 0;
      $$rlp{"delta_e0val$i"}  = 0;
      next;
    };
    ## fill the other two tabs
    if ($list[0] =~ /$s/) {

      my $ii = 0;
      foreach my $ke (@{$$rlp{keys}}) {
	next if ($ke eq 'None');
	++$ii;
	last if ($ke eq $s);
      };
      $$rlp{"standard$i"}     = $s;
      $$rlp{"standard_lab$i"} = $groups{$s}->{lcf_menu_label};

      my ($v, $w) = (10+4*$i, 11+4*$i);
      $widget{lcf_result_table}->itemConfigure($s, 2,
					       -text=>sprintf("%.3f (%.3f)", $list[$v]||0, $list[$w]||0));
      $$rlp{"value$i"}        = $list[$v];
      $$rlp{"delta_value$i"}  = $list[$w];

      ($v, $w) = (12+4*$i, 13+4*$i);
      $widget{lcf_result_table}->itemConfigure($s, 3,
					       -text=>sprintf("%.3f (%.3f)", $list[$v]||0, $list[$w]||0));
      $$rlp{"e0val$i"}        = $list[$v];
      $$rlp{"delta_e0val$i"}  = $list[$w];

    } else {

      $widget{lcf_result_table}->itemConfigure($s, 2, -text=>" ");
      $widget{lcf_result_table}->itemConfigure($s, 3, -text=>" ");

      $$rlp{"standard$i"}     = 'None';
      $$rlp{"standard_lab$i"} = '0: None';
      $$rlp{"value$i"}        = 0;
      $$rlp{"delta_value$i"}  = 0;
      $$rlp{"e0val$i"}        = 0;
      $$rlp{"delta_e0val$i"}  = 0;
    };
    $groups{$current} -> MAKE("lcf_standard$i"	   => $$rlp{"standard$i"},
			      "lcf_standard_lab$i" => $$rlp{"standard_lab$i"},
			      "lcf_value$i"	   => $$rlp{"value$i"},
			      "lcf_delta_value$i"  => $$rlp{"delta_value$i"},
			      "lcf_e0val$i"	   => $$rlp{"e0val$i"},
			      "lcf_delta_e0val$i"  => $$rlp{"delta_e0val$i"},
			     );
  };
  ## fill up stats and others
  $$rlp{rfact}	    = $list[1];
  $$rlp{chisqr}	    = $list[2];
  $$rlp{chinu}	    = $list[3];
  $$rlp{fit_status} = $list[4];
  $$rlp{nvarys}	    = $list[5];
  $$rlp{ndata}	    = $list[6];
  if ($$rlp{linear}) {
    $widget{lcf_result_table}->itemConfigure('linear', 2,
					     -text=>sprintf("%.3f (%.3f)", $list[10],  $list[11]));
    $widget{lcf_result_table}->itemConfigure('linear', 3,
					     -text=>sprintf("%.6f (%.6f)", $list[12], $list[13]));
  };

  $groups{$current} -> MAKE(lcf_rfact	    => $list[1],
			    lcf_chisqr	    => $list[2],
			    lcf_chinu	    => $list[3],
			    lcf_fit_status  => $list[4],
			    lcf_nvarys	    => $list[5],
			    lcf_ndata	    => $list[6],
			    lcf_fitmin      => $list[7],
			    lcf_fitmax      => $list[8],
			    lcf_yint        => $list[10],
			    lcf_delta_yint  => $list[11],
			    lcf_slope       => $list[12],
			    lcf_delta_slope => $list[13],
			   );


  $top -> update;
  $widget{lcf_operations} -> entryconfigure(1, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(3, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(4, -state=>'normal', -style=>$$rlp{normal_style});
  $widget{lcf_operations} -> entryconfigure(7, -state=>'normal', -style=>$$rlp{normal_style})
    if ($$rlp{fitspace} eq 'k');
  if ($plot) {
    if ($$rlp{fitspace} eq 'k') { lcf_arrays_k(0) } else { lcf_arrays_e() };
    lcf_results($rlp);
    lcf_plot($rlp);
  };
};


sub lcf_post_menu {

  ## figure out where the user clicked
  my $w = shift;
  my $Ev = $w->XEvent;
  delete $w->{'shiftanchor'};
  my $entry = $w->GetNearest($Ev->y, 1);
  return unless (defined($entry) and length($entry));

  ## select and anchor the right-clicked parameter
  #$w->selectionClear;
  $w->anchorSet($entry);
  #$w->selectionSet($entry);

  #my @order  = $widget{lcf_result_table}->info('children');
  #$$hash_pointer{toggle} = 1;
  #lcf_fill_result(\@order, $hash_pointer, 1);


  ## post the message with parameter-appropriate text
  my $which = $w->info('anchor');
  $which    = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  my $id = $widget{lcf_select_table}->itemCget($entry, 0, '-text');
  my ($X, $Y) = ($Ev->X, $Ev->Y);
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[[ command=>"Write column data file for fit using $id",
		       -command=>sub{$top->Busy;
				     $w->selectionClear;
				     $w->selectionSet($entry);
				     my @order  = $widget{lcf_result_table}->info('children');
				     $$hash_pointer{toggle} = 1;
				     lcf_fill_result(\@order, $hash_pointer, 1);
				     &lcf_save_fit;
				     $top->Unbusy;}
		      ],
		      [ command=>"Make data group for fit using $id",
		       -command=>sub{$top->Busy;
				     $w->selectionClear;
				     $w->selectionSet($entry);
				     my @order  = $widget{lcf_result_table}->info('children');
				     $$hash_pointer{toggle} = 1;
				     lcf_fill_result(\@order, $hash_pointer, 1);
				     &lcf_group($hash_pointer);
				     $top->Unbusy;},
		      ],
		      [ command=>"Write report for fit using $id",
		       -command=>sub{$top->Busy;
				     $w->selectionClear;
				     $w->selectionSet($entry);
				     my @order  = $widget{lcf_result_table}->info('children');
				     $$hash_pointer{toggle} = 1;
				     lcf_fill_result(\@order, $hash_pointer, 1);
				     &lcf_report;
				     $top->Unbusy;}
		      ],
		      "-",
		      [ command=>"Write CSV report for all fits",
		       -command=>\&lcf_csv_report,
		      ],
		     ])
      -> Post($X, $Y);
  $w -> break;
};


sub lcf_save_fit {
  my $path = $current_data_dir || Cwd::cwd;
  my $id = $widget{lcf_select_table} -> itemCget($widget{lcf_select_table}->selectionGet, 0, "-text");
  $id =~ s/,/_/g;
  my $f = $groups{$current}->{label} . ".fit_$id";
  $f =~ s/ /_/g;
  my $types = [['Comma separated values', '.csv'], ['All files', '*']];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$f,
				 -title => "Athena: Write linear combination fitting result");
  Echo("Not writing linear combination fit result file"), return unless $file;

  if ($$hash_pointer{fitspace} eq 'k') { lcf_arrays_k(0) } else { lcf_arrays_e() };

  refresh_titles($groups{$current}); # make sure titles are up-to-date
  $groups{$current}->dispose("\$id_line_1 = \"Athena data file -- Athena version $VERSION\"", $dmode);
  $groups{$current}->dispose("\$id_line_2 = \"Saving LCF fit to $groups{$current}->{label}\"", $dmode);
  my $n = 3;

  my $arrays = "l___cf.mix, l___cf.diff";
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    my $line = "\$id_line_$n = \"~  $i: " . $$hash_pointer{"standard_lab$i"}  . "\"";
    $groups{$current}->dispose($line, $dmode);
    $arrays .= ", l___cf.$i";
    ++$n;
  };
  $groups{$current}->dispose("\$id_line_$n = \"~\"\n", $dmode);
  my $i = 0;
  foreach my $l (split(/\n/, $groups{$current}->param_summary)) {
    ++$i;
    $groups{$current}->dispose("\$param_line_$i = \"$l\"", $dmode);
  };
  if ($$hash_pointer{fitspace} eq 'k') {
    $groups{$current}->dispose("write_data(file=\"$file\", \$id_line_\*, \$param_line_\*, \$${current}_title_\*, $current.k, l___cf.data, $arrays)\n", $dmode);
  } else {
    my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
    ($suff = 'norm') if ($$hash_pointer{fitspace} eq 'd');
    $groups{$current}->dispose("write_data(file=\"$file\", \$id_line_\*, \$param_line_\*, \$${current}_title_\*, $current.energy, $current.$suff, $arrays)\n", $dmode);
  };

};

sub lcf_constrain {
  my $how = $_[0];
  my @keys = qw(lcf_nonneg lcf_100 lcf_linear lcf_noise lcf_fitspace
                lcf_fitmin_k lcf_fitmin_e
                lcf_fitmax_k lcf_fitmax_e
               );
  foreach my $i (1 .. $config{linearcombo}{maxspectra}) {
    next if ($$hash_pointer{"standard$i"} eq 'None');
    push @keys, "lcf_standard$i", "lcf_standard_lab$i", "lcf_value$i", "lcf_e0$i", "lcf_e0val$i";
  };
  set_params($how, @keys);
};


sub lcf_purge {
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  if ($fat_showing eq 'lcf') {
    Error("You may not purge LCF results while the LCF dialog is showing.");
    return;
  };
  foreach my $g (keys %groups) {
    foreach my $k (keys %{$groups{$g}}) {
      #print "$g $k\n";
      next unless ($k =~ /^lcf/);
      delete $groups{$g}->{$k};
    };
  };
  %lcf_data = ();
  project_state(0);
};

## END OF LINEAR COMBINATION FITTING SUBSECTION
##########################################################################################

## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  rebinning data.

sub rebin {

  ## generally, we do not change modes unless there is data.
  ## exceptions include things like the prefernces and key bindings,
  ## which are data-independent
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");

  ## this is a way of testing the current list of data groups for some
  ## necessary property.  for the demo, this will just be the list of
  ## groups
  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters, as in the commented out
  ## example
  my %rebin_params;
  $rebin_params{abs}  = $groups{$current}->{bkg_z};
  $rebin_params{edge} = $groups{$current}->{bkg_e0};
  foreach (qw(emin emax pre exafs xanes)) {
    $rebin_params{$_}  = $config{rebin}{$_};
  };

  ## you probably do not want the standard and the unknown to be the
  ## same group
  # set_properties(1, $keys[1], 0) if ($current eq $keys[0]);

  ## you may wish to provide a better guess for which should be the
  ## standard and which the unknown.  you may also want to adjust the
  ## view of the groups list to show the unknown -- the following
  ## works...
  my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
  ($here < 0) and ($here = 0);
  my $full = ($list->bbox(@skinny_list))[3] + 5;
  $list -> yview('moveto', $here/$full);

  ## these two global variables must be set before this view is
  ## displayed.  these are used at the level of set_properties to
  ## perform chores appropriate to this dialog when changing the
  ## current group
  $fat_showing = 'rebin';
  $hash_pointer = \%rebin_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $rebin = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$foobar -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $rebin;

  ## the standard label along the top identifying this analysis chore
  $rebin -> Label(-text=>"Data Rebinning",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## a good solution to organizing widgets is to stack frames, so
  ## let's make a frame for the standard and the other.  note that the
  ## "labels" are actually flat buttons which display hints in the
  ## echo area
  my $frame = $rebin -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -pady=>4);

  $frame -> Label(-text=>"Group: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widget{rb_group} = $frame -> Label(-text=>$groups{$current}->{label},
				      -foreground=>$config{colors}{button})
    -> grid(-row=>0, -column=>1, -columnspan=>2, -sticky=>'w');

  $frame -> Label(-text=>'Edge energy:',
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $frame -> Label(-textvariable=>\$rebin_params{edge})
    -> grid(-row=>1, -column=>1, -columnspan=>2, -sticky=>'w', -padx=>2);

  $frame -> Label(-text=>'Edge region from:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin_params{emin},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>2, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>' to ',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>2);
  $frame -> Entry(-width=>5, -textvariable=>\$rebin_params{emax},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>2, -column=>3, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>4);

  $frame -> Label(-text=>'Pre edge grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin_params{pre},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>3, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>2, -sticky=>'w',);

  $frame -> Label(-text=>'XANES grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin_params{xanes},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>4, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'eV',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>4, -column=>2, -sticky=>'w',);

  $frame -> Label(-text=>'EXAFS grid:',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>5, -column=>0, -sticky=>'e');
  $frame -> Entry(-width=>5, -textvariable=>\$rebin_params{exafs},
		  -validate=>'key',
		  -validatecommand=>[\&set_variable, 'rebin'])
    -> grid(-row=>5, -column=>1, -sticky=>'w', -padx=>2);
  $frame -> Label(-text=>'1/Ang',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>5, -column=>2, -sticky=>'w',);

  $frame -> Label(-text=>" ")
      -> grid(-row=>6, -column=>0, -columnspan=>5, -sticky=>'ew',);

  $widget{rb_plot} =
    $frame -> Button(-text=>'Plot data and rebinned data',  @button_list,
		     -width=>1,
		     -state=>($groups{$current}->{is_xmu}) ? 'normal' : 'disabled',
		     -command=>sub{rebin_do(\%rebin_params)})
      -> grid(-row=>7, -column=>0, -columnspan=>5, -sticky=>'ew',);

  $widget{rb_save} = $frame -> Button(-text=>'Make rebinned data group',  @button_list,
				      -width=>1,
				      -state=>'disabled',
				      -command=>sub{rebin_group($current, \%rebin_params, $dmode)})
    -> grid(-row=>8, -column=>0, -columnspan=>5, -sticky=>'ew',);
  $widget{rb_marked} = $frame -> Button(-text=>'Rebin marked data and make groups',  @button_list,
					-width=>1,
					-command=>sub{
					  Echo("Rebinning marked groups ...");
					  $top -> Busy;
					  my $restore = $current;
					  foreach my $g (&sorted_group_list) {
					    next unless $marked{$g};
					    set_properties(0, $g, 0);
					    rebin_do(\%rebin_params);
					    rebin_group($current, \%rebin_params, $dmode)
					  };
					  set_properties(1, $restore, 0);
					  $top -> Unbusy;
					  Echo("Rebinning marked groups ... done!");
					  $top -> update;
					})
    -> grid(-row=>9, -column=>0, -columnspan=>5, -sticky=>'ew',);


  ## this is a spacer frame which pushes all the widgets to the top
  $rebin -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $rebin -> Button(-text=>'Return to the main window',  @button_list,
		   -background=>$config{colors}{background2},
		   -activebackground=>$config{colors}{activebackground2},
		   -command=>sub{$groups{$current}->dispose("erase \@group re___bin", $dmode);
				 &reset_window($rebin, "rebinning", 0);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $rebin -> Button(-text=>'Document section: rebinning data', @button_list,
		   -command=>sub{pod_display("process::rebin.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  $top -> update;

};


sub rebin_do {
  my $rparams = $_[0];
  $$rparams{emin}  ||= $config{rebin}{emin};
  $$rparams{emax}  ||= $config{rebin}{emax};
  $$rparams{pre}   ||= $config{rebin}{pre};
  $$rparams{xanes} ||= $config{rebin}{xanes};
  $$rparams{exafs} ||= $config{rebin}{exafs};
  ## these must be positive or bad stuff will happen
  $$rparams{pre}   = abs($$rparams{pre});
  $$rparams{xanes} = abs($$rparams{xanes});
  $$rparams{exafs} = abs($$rparams{exafs});
  ## check if emin, emax out of order
  (($$rparams{emin}, $$rparams{emax}) = ($$rparams{emax}, $$rparams{emin})) if
    ($$rparams{emin} > $$rparams{emax});

  my $group = $groups{$current}->{group};
  Echo("Rebinning data $groups{$group}->{label} ...");
  my $e0shift = $groups{$group}->{bkg_eshift};
  my @e = Ifeffit::get_array("$group.energy");
  my ($efirst, $elast) = ($e[0]+$e0shift, $e[$#e]+$e0shift);
  my $e0 = $groups{$current}->{bkg_e0};
  $groups{$group}->dispose("## Rebinning group $group:", $dmode);
  my @bingrid;
  my $ee = $efirst;
  while ($ee < $$rparams{emin}+$e0) {
    push @bingrid, $ee;
    $ee += $$rparams{pre};
  };
  $ee = $$rparams{emin}+$e0;
  while ($ee < $$rparams{emax}+$e0) {
    push @bingrid, $ee;
    $ee += $$rparams{xanes};
  };
  $ee = $$rparams{emax}+$e0;
  my $kk = $groups{$group}->e2k($$rparams{emax});
  while ($ee < $elast) {
    push @bingrid, $ee;
    $kk += $$rparams{exafs};
    $ee = $e0 + $groups{$group}->k2e($kk);
  };
  push @bingrid, $elast;
  Ifeffit::put_array("re___bin.energy", \@bingrid);
  my $sets = "set($group.eee = $group.energy+$e0shift,\n";
  $sets   .= "    re___bin.xmu = rebin($group.eee, $group.xmu, re___bin.energy)";
  $sets   .= ",\n    re___bin.i0  = rebin($group.eee, $group.i0,  re___bin.energy)"
    if ($groups{$group}->{i0});
  $sets   .= ")";
  $groups{$group}->dispose($sets, $dmode);
  $groups{$group} -> plotE('em', $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$group} -> dispose("plot(re___bin.energy, re___bin.xmu, style=lines, color=\"$color\", key=rebinned)", $dmode);
  $last_plot='e';
  $widget{rb_save} -> configure(-state=>'normal');
  Echo("Rebinning data $groups{$group}->{label} ... done!");
};

sub rebin_group {
  my ($parent, $rparams, $mode) = @_;
  my ($group, $label) = ("Bin ".$groups{$parent}->{label}, "");
  ($group, $label) = group_name($group);
  my $e0shift = $groups{$parent}->{bkg_eshift};
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  ## copy the titles
  push @{$groups{$group}->{titles}},
    "$groups{$parent}->{label} rebinned onto a grid with boundaries at $$rparams{emin} eV and $$rparams{emax} eV",
      "and steps sizes of $$rparams{pre} eV, $$rparams{xanes} eV, and $$rparams{exafs} 1/Ang";
  $groups{$group} -> make(file=>"$groups{$parent}->{label} rebinned");
  foreach (@{$groups{$parent}->{titles}}) {
    push   @{$groups{$group}->{titles}}, $_;
  };
  $groups{$group} -> put_titles;
  $groups{$group} -> set_to_another($groups{$parent});
  $groups{$group} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0, is_qsp => 0, is_bkg => 0,
			  not_data => 0,);
  my $sets = "set($group.energy = re___bin.energy-$e0shift,\n";
  $sets   .= "    $group.xmu = re___bin.xmu";
  $sets   .= ",\n    $group.i0 = re___bin.i0"
    if ($groups{$group}->{i0});
  $sets   .= ")";
  $groups{$group} -> dispose($sets, $dmode);

  ## rebin arrays for detector groups
  $groups{$group} -> make(numerator   => "$group.numer",
			  denominator => "$group.denom");
  my $cmd = "set(r___b.array = $groups{$parent}->{numerator},\n";
  $cmd   .= "    $group.numer = rebin($parent.energy, r___b.array, $group.energy),\n";
  $cmd   .= "    r___b.array = $groups{$parent}->{denominator},\n";
  $cmd   .= "    $group.denom = rebin($parent.energy, r___b.array, $group.energy))\n";
  $cmd   .= "erase r___b.array\n";
  $groups{$group} -> dispose($cmd,$dmode);

  ++$line_count;
  fill_skinny($list, $group, 1, 0);
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};

## END OF REBINNING SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  smoothing data.



sub smooth {
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };
  my $g = ($groups{$current}->{is_xmu}) ? $current : $keys[0];
  my $g_label = $groups{$g}->{label};

  my $mode = 0;
  my $grey = '#9c9583';
  my $ahc  = $config{colors}{activehighlightcolor};
  my %smooth_params = (rmax=>$config{smooth}{rmax},
		       nit =>$config{smooth}{iterations});

  $fat_showing = 'smooth';
  $hash_pointer = \%smooth_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $sm = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$sm -> packPropagate(0);
  $which_showing = $sm;

  $sm -> Label(-text=>"Data smoothing",
	       -font=>$config{fonts}{large},
	       -foreground=>$ahc)
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  my $frame = $sm -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-ipadx=>3, -ipady=>3, -fill=>'x');  ## select the group to smooth
  my $fr = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -ipady=>3, -ipady=>3);
  $fr -> Label(-text=>"Group: ",
	       -foreground=>$config{colors}{activehighlightcolor},
	      )
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widget{sm_group} = $fr -> Label(-text=>$groups{$current}->{label},
				      -foreground=>$config{colors}{button})
    -> grid(-row=>0, -column=>1, -sticky=>'w');

  $sm -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');
  $sm -> Button(-text=>'Return to the main window',  @button_list,
		-background=>$config{colors}{background2},
		-activebackground=>$config{colors}{activebackground2},
		-command=>sub{&reset_window($sm, "smoothing", 0);})
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $sm -> Button(-text=>'Document section: data smoothing', @button_list,
		-command=>sub{pod_display("process::smooth.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  ## frame with widgets in
  $fr = $frame -> Frame()
    -> pack(-fill=>'both');
  ## choose smoothing method
  $widget{sm_it_button} =
  $fr ->
    Radiobutton(-text=>"Interpolative smoothing", -variable=>\$mode, -value=>0,
		-foreground=>$config{colors}{activehighlightcolor},
		-activeforeground=>$config{colors}{activehighlightcolor},
		-command=>sub{$widget{sm_it_lab}->configure(-foreground=>$ahc);
			      $widget{sm_it_ent}->configure(-state=>'normal');
			      $widget{sm_ff_lab}->configure(-foreground=>$grey);
			      $widget{sm_ff_ent}->configure(-state=>'disabled');
			    })
    -> grid(-row=>0, -column=>0, -ipady=>4);
  $widget{sm_it_lab} = $fr -> Label(-text=>"     ",)
    -> grid(-row=>0, -column=>1, -sticky=>'e');
  $widget{sm_it_lab} = $fr -> Label(-text=>"Number of iterations:",
				    -foreground=>$config{colors}{activehighlightcolor},
				   )
    -> grid(-row=>0, -column=>2, -sticky=>'e');
  $widget{sm_it_ent} = $fr -> NumEntry(-width=>4, -value=>10, -minvalue=>1,
				       -foreground=>$config{colors}{foreground})
    -> grid(-row=>0, -column=>3, -sticky=>'w');
  $widget{sm_ff_button} =
  $fr -> Radiobutton(-text=>"Fourier filter smoothing", -variable=>\$mode, -value=>1,
		     -foreground=>$config{colors}{activehighlightcolor},
		     -activeforeground=>$config{colors}{activehighlightcolor},
		     -command=>sub{$widget{sm_it_lab}->configure(-foreground=>$grey);
				   $widget{sm_it_ent}->configure(-state=>'disabled');
				   $widget{sm_ff_lab}->configure(-foreground=>$ahc);
				   $widget{sm_ff_ent}->configure(-state=>'normal');
				 })
    -> grid(-row=>1, -column=>0, -ipady=>4);
  $widget{sm_ff_lab} = $fr -> Label(-text=>"Rmax:",
				    -foreground=>$grey,
				   )
    -> grid(-row=>1, -column=>2, -sticky=>'e');
  $widget{sm_ff_ent} = $fr -> Entry(-width=>8, )
    -> grid(-row=>1, -column=>3, -sticky=>'w');

  ## buttons for doing smoothing and making smoothed group
  $fr = $frame -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -padx=>2, -pady=>2, -ipadx=>2, -ipady=>2);
  $widget{sm_plot} =
    $fr -> Button(-text=>'Plot data and smoothed spectrum',  @button_list,
		  -width=>1,
		  -command=>sub{&do_smoothing($current, $mode, $widget{sm_it_ent}->get,
					      $widget{sm_ff_ent}->get);
				$widget{sm_save} -> configure(-state=>'normal'); })
    -> pack(-fill=>'x', -expand=>1, -side=>'left');
  $widget{sm_save} = $fr -> Button(-text=>'Make smoothed data group',  @button_list,
				   -width=>1,
				   -state=>'disabled',
				   -command=>sub{&smooth_group($current, $mode,
							       $widget{sm_it_ent}->get,
							       $widget{sm_ff_ent}->get)})
    -> pack(-fill=>'x', -expand=>1, -side=>'left');

  $widget{sm_ff_ent} -> insert(0, '6');
  $widget{sm_ff_ent} -> configure(-state=>'disabled');

  $plotsel -> raise('e');
};


sub do_smoothing {
  my ($group, $mode, $nit, $rmax) = @_;
  Error("Smoothing aborted: " . $groups{$group}->{label} . " is not an xmu group."),
    return unless ($groups{$group}->{is_xmu});
  my $e0shift = $groups{$group}->{bkg_eshift};

 SWITCH: {
    ($mode == 0) and do {	# interpolative
      $groups{$group} -> dispose("set $group.smoothed = $group.xmu", $dmode);
      foreach (1 .. $nit) {
	$groups{$group} -> dispose("set $group.temp = smooth($group.smoothed)  # $_", $dmode);
	$groups{$group} -> dispose("set $group.smoothed = $group.temp", $dmode);
	$groups{$group} -> dispose("erase $group.temp", $dmode);
	Echo("Smoothed $groups{$group}->{label} using $nit smoothing iterations");
      };
      last SWITCH;
    };
    ($mode == 1) and do {	# Fourier filter
      $groups{$group} -> dispose("min_e = floor($group.energy)", $dmode);
      $groups{$group} -> dispose("set tem___p.k  = sqrt(($group.energy + $e0shift - min_e)*etok)", $dmode);
      $groups{$group} -> dispose("set max_k = ceil(tem___p.k)", $dmode);
      $groups{$group} -> dispose("set tem___p.kk = range(0, max_k, 0.01)", $dmode);
      $groups{$group} -> dispose("set tem___p.xk = interp(tem___p.k, $group.xmu, tem___p.kk)",
				 $dmode);
      ## build a symmetric function by doing a mirror transform at the end
      ## of the data range
      my @xarr = get_array("tem___p.kk");
      my @x = ();
      push @x, @xarr;
      map {push @x, $xarr[$#xarr]+$_} @xarr; # this doubles the x-axis grid

      my @backhalf = get_array("tem___p.xk");
      my @y = ();
      push @y, @backhalf;
      @backhalf = reverse @backhalf;
      push @y, @backhalf; # this is the data + the mirror of the data

      ## stuff the mirrored data back into ifeffit
      put_array("tem___p.x", \@x);
      put_array("tem___p.y", \@y);

      $groups{$group} -> dispose("## put mirrored arrays back into Ifeffit's memory ...", $dmode);
      $groups{$group} -> dispose("fftf(tem___p.y, k=tem___p.x, kmin=0, kmax=2*max_k, dk=0)", $dmode);
      #$groups{$group} -> dispose("show \@group tem___p", $dmode);
      $groups{$group} -> dispose("fftr(real=tem___p.chir_re, imag=tem___p.chir_im, rmin=0, rmax=$rmax, dr=0)", $dmode);
      $groups{$group} -> dispose("set $group.smoothed = interp(tem___p.q, tem___p.chiq_re, tem___p.k)", $dmode);
      $groups{$group} -> dispose("erase \@group tem___p", $dmode);
      Echo("Smoothed $groups{$group}->{label} by Fourier filtering to $rmax Angstroms");
      last SWITCH;
    };
  };
  ## plot it up
  $groups{$group} -> plotE('em', $dmode, \%plot_features, \@indicator);
  my $color = $plot_features{c1};
  $groups{$group} -> dispose("plot(\"$group.energy+$e0shift\", $group.smoothed, style=lines, color=\"$color\", key=smoothed)", $dmode);
  $last_plot='e';
};


sub smooth_group {
  my ($parent, $mode, $nit, $rmax) = @_;
  my ($group, $label) = ("SM ".$groups{$parent}->{label}, "");
  ($group, $label) = group_name($group);
  $groups{$group} = Ifeffit::Group -> new(group=>$group, label=>$label);
  ## copy the titles
  if ($mode == 0) {
    push @{$groups{$group}->{titles}},
      "$groups{$parent}->{label} smoothed by interpolative smoothing with $nit iterations";
    $groups{$group} -> make(file=>"$groups{$parent}->{label} smoothed by interpolative smoothing with $nit iterations");
  } elsif ($mode == 1) {
    push @{$groups{$group}->{titles}},
      "$groups{$parent}->{label} smoothed by Fourier filtering to $rmax Angstroms";
    $groups{$group} -> make(file=>"$groups{$parent}->{label} smoothed by Fourier filtering to $rmax Angstroms");
  };
  foreach (@{$groups{$parent}->{titles}}) {
    push   @{$groups{$group}->{titles}}, $_;
  };
  $groups{$group} -> put_titles;
  $groups{$group} -> set_to_another($groups{$parent});
  $groups{$group} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0, is_qsp => 0, is_bkg => 0,
			  not_data => 0,);
  $groups{$group} -> dispose("set($group.energy = $parent.energy, $group.xmu = $parent.smoothed)", $dmode);
  $groups{$group} -> dispose("erase $parent.smoothed", $dmode);
  ++$line_count;
  fill_skinny($list, $group, 1);
  my $memory_ok = $groups{$group} -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo ("WARNING: Ifeffit is out of memory!") if ($memory_ok == -1);
};



## END OF DATA SMOOTHING SUBSECTION
##########################################################################################

## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This file contains the data convolution dialog



sub convolve {

  ## generally, we do not change modes unless there is data.
  ## exceptions include things like the prefernces and key bindings,
  ## which are data-independent
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");

  ## this is a way of testing the current list of data groups for some
  ## necessary property.  for the demo, this will just be the list of
  ## groups
  my @keys = ();
  foreach my $k (&sorted_group_list) {
    ($groups{$k}->{is_xmu}) and push @keys, $k;
  };
  Echo("You need at least one xmu group to do convolution"), return unless (@keys);

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters
  my %conv_params;
  $conv_params{econv} = 0;
  $conv_params{noise} = 0;
  $conv_params{function} = "Lorentizan";
  $conv_params{current} = $groups{$current}->{label};


  ## The Athena standard for analysis chores that need a specialized
  ## plotting range is to save the plotting range from the main view
  ## and restore it when the main view is restored
  # my @save = ($plot_features{emin}, $plot_features{emax});
  # $plot_features{emin} = $config{foobar}{emin};
  # $plot_features{emax} = $config{foobar}{emax};

  ## these two global variables must be set before this view is displayed
  $fat_showing = 'convolve';
  $hash_pointer = \%conv_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $conv = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$conv -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $conv;

  ## the standard label along the top identifying this analysis chore
  $conv -> Label(-text=>"Data convolution",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## a good solution to organizing widgets is to stack frames, so
  ## let's make a frame for the standard and the other.  note that the
  ## "labels" are actually flat buttons which display hints in the
  ## echo area
  my $frame = $conv -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -fill=>'x', -pady=>8);
  $frame -> Label(-text=>"Group: ", -foreground => $config{colors}{button},)
    -> grid(-row=>0, -column=>0, -sticky=>'e', -pady=>2, -ipadx=>6);
  $frame -> Label(-textvariable=>\$conv_params{current},)
    -> grid(-row=>0, -column=>1, -sticky=>'w', -pady=>2);
  $frame -> Label(-text=>"Convolution function: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -pady=>2);
  $frame -> Optionmenu(-textvariable => \$conv_params{function},
		       -variable => \$conv_params{function},
		       -borderwidth=>1,
		       -options => ['Lorentzian', 'Gaussian'])
    -> grid(-row=>1, -column=>1, -sticky=>'w');

  $frame -> Label(-text=>"Convolution width: ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>2, -column=>0, -sticky=>'e', -pady=>2);
  $widget{conv_econv} = $frame -> Entry(-width=>8,
					-textvariable => \$conv_params{econv},
					-validate=>'key',
					-validatecommand=>[\&set_variable, 'conv_econv']
				       )
    -> grid(-row=>2, -column=>1, -sticky=>'w', -pady=>2);

  $frame -> Label(-text=>"Noise (fraction of edge step): ",
		  -foreground=>$config{colors}{activehighlightcolor},
		 )
    -> grid(-row=>3, -column=>0, -sticky=>'e', -pady=>2);
  $widget{conv_noise} = $frame -> Entry(-width=>8,
					-textvariable => \$conv_params{noise},
					-validate=>'key',
					-validatecommand=>[\&set_variable, 'conv_noise']
				       )
    -> grid(-row=>3, -column=>1, -sticky=>'w', -pady=>2);


#  $frame = $conv -> Frame(-borderwidth=>2, -relief=>'flat')
#    -> pack(-side=>'top', -fill=>'x', -pady=>4);
  $frame -> Button(-text=>'Plot data and convolution',  @button_list,
		   -width=>1,
		   -command=>sub{convolve_plot(\%conv_params)}
		  )
    -> grid(-row=>4, -column=>0, -columnspan=>2, -sticky=>'ew', -pady=>6);

  $widget{conv_group} = $frame -> Button(-text=>'Make data group',
					 -width=>1,
					 @button_list,
					 -state=>'disabled',
					 -command=>sub{convolve_group(\%conv_params)}
					)
    -> grid(-row=>5, -column=>0, -columnspan=>2, -sticky=>'ew', -pady=>2);

  ## this is a spacer frame which pushes all the widgets to the top
  $conv -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');


  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $conv -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{&reset_window($conv, "convolution", 0);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $conv -> Button(-text=>'Document section: Convoluting data', @button_list,
		   -command=>sub{pod_display("process::conv.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  ## and finally....
  $groups{$current}->plotE('emn', $dmode, \%plot_features, \@indicator);
  $top -> update;

};

sub convolve_plot {
  my $rhash = $_[0];
  Error("The convolution width must be positive."), return if ($$rhash{econv} < 0);
  Error("The noise level is a fraction of the edge step) and must be non-negative."), return if ($$rhash{noise} < 0);
  Echonow("Convoluting is time consuming (patience is a virtue!) ...");
  $top->Busy;
  my $group = $groups{$current}->{group};
  my $suff = ($groups{$current}->{bkg_flatten}) ? 'flat' : 'norm';
  my $function = ($$rhash{function} eq 'Lorentzian') ? 'lconvolve' : 'gconvolve';
  my $color = $config{plot}{c1};
  my $key = 'convolution';
  my $eshift = $groups{$current}->{bkg_eshift};
  my $step = $groups{$current}->{bkg_step};
  my $yoff = $groups{$current}->{plot_yoffset};
  my $command = "## make convoluted spectrum:\n";
  if ($$rhash{noise}) {
    $command .= "set(c___onv_nn = npts($group.energy),\n";
    $command .= "    c___onv_noise = $$rhash{noise})\n";
    $command .= "random(output=$group.random, npts=c___onv_nn, dist=normal, sigma=c___onv_noise)\n";
    if ($$rhash{econv} == 0) {
      $command .= "set c___onv.y = $group.$suff+$group.random\n";
    } else {
      $command .= "set c___onv.y = $function($group.energy, $group.$suff, $$rhash{econv})+$group.random\n";
    };
  } else {
    if ($$rhash{econv} == 0) {
      $command .= "set c___onv.y = $group.$suff\n";
    } else {
      $command .= "set c___onv.y = $function($group.energy, $group.$suff, $$rhash{econv})\n";
    };
  };
  $command   .= "plot(\"$group.energy+$eshift\", \"c___onv.y+$yoff\",  key=$key, style=lines, color=$color)\n",
  $groups{$current}->plotE('emn', $dmode, \%plot_features, \@indicator);
  $groups{$current}->dispose($command, $dmode);
  $widget{conv_group}->configure(-state=>'normal');
  Echo("Convoluting ... done!");
  $top->Unbusy;
};



## make a new data group out of the convolved function, make this an
## xmu group so it can be treated like normal data
sub convolve_group {
  my $rhash = $_[0];
  my $group = $groups{$current}->{group};
  my ($new, $label) = group_name("Conv ".$$rhash{econv}." ".$group);
  $groups{$new} = Ifeffit::Group -> new(group=>$new,
					label=>"Conv " . $$rhash{econv} . $groups{$current}->{label});
  $groups{$new} -> set_to_another($groups{$group});
  $groups{$new} -> make(is_xmu => 1, is_chi => 0, is_rsp => 0,
			is_qsp => 0, is_bkg => 0, is_nor => 1,
			not_data => 0);
  $groups{$new} -> make(bkg_e0 => $groups{$group}->{bkg_e0});
  $groups{$new} -> make(file => "$$rhash{function} conv. of $groups{$current}->{label} by $$rhash{econv} volts with $$rhash{noise} noise");
  $groups{$new}->{titles} = [];
  push @{$groups{$new}->{titles}},
    "$$rhash{function} convolution of $groups{$current}->{label} by $$rhash{econv} volts",
      "with noise of $$rhash{noise} (compared to normalized spectrum)";
  $groups{$new} -> put_titles;
  my $sets = "set($new.energy = $group.energy,";
  $sets   .= "    $new.xmu = c___onv.y)";
  $groups{$new} -> dispose($sets, $dmode);
  ++$line_count;
  fill_skinny($list, $new, 1, 1);
  project_state(0);
  my $memory_ok = $groups{$new}
    -> memory_check($top, \&Echo, \%groups, $max_heap, 0, 0);
  Echo("WARNING: Ifeffit is out of memory!"), return if ($memory_ok == -1);
  Echo("Saved convolution of $groups{$current}->{label} as a new data group");
};


## END OF CONVOLUTION SUBSECTION
##########################################################################################

## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This file demonstrates how to add a new analysis feature to Athena


##  0.  Write all the subroutines needed to perform this chore.
##      Typically the sub that presents the view in the main window is
##      in the same file as all the subs that are needed to perform
##      the chore.  Add your new file to the file list used to build
##      athena.pl from its parts in Makefile.PL and in the mkathena
##      utility.

##  1.  Follow the example in this file for preparing your page.
##      Populate it with widgets as desired.  Try to maintain some
##      visual consistency with other views, unless, of course, you
##      have a beter idea

##  2.  Make an entry in the appropriate menu.  if you add to the Data
##      or File menus, you will need to take care with the indeces
##      used to enable/disable menu items.  this is mostly done in the
##      first part of set_properties

##  3.  Add an entry to the FAT block at the end of set_properties
##      that will correctly handle any chores that need doing whenever
##      the current group changes

##  4.  You should try to make use of the current and marked groups as
##      a way of selecting groups for analysis.  from a UI perspective
##      it is a bad idea to make special ways of incorporating data
##      into the analysis.  the one exception is the use of an
##      optionmenu to define the "standard" for the analysis chore

##  5.  Add a section to athena.config with any configuration
##      variables that your users might need.  feel free to add new
##      colors or fonts to athena.config, but do try to reuse the ones
##      that are already there

##  6.  If any of the configuration parameters require special
##      handling at the time they are reconfigured, add that to the
##      end of the prefs_apply subroutine

##  7.  Add key binding data to the set_key_data subroutine following
##      the commented out example.  at the very least, you should add
##      your top level function so that the view can be accessed from
##      the keyboard.  it would be best to provide bindings to every
##      button click on your page

##  8.  If you add this function to the Analysis or Data menus, you
##      should add a help balloon hint.  this is done in head.pl near
##      the menubutton_attach subroutine

##  9.  Write a document section and add a link to it in athena.pod.
##      Also add a menu entry to your new pod in the document sections
##      cascade in the $help_menu

## 10.  It is ok to add new parameters to the Group object which have
##      to do with this analysis chore.  This can usually be done
##      without harming any other part of the code.  It would be a
##      good idea to follow a naming scheme for your new object
##      parameters -- something like 'foobar_spiffyparam'.  It is
##      probably not necessary to initialize these new parameters in
##      Group.pm, however you may need to add some code to the file
##      reading or group initializing code to deal with those
##      parameters.  Cerrtainly it is ok to modify other object
##      parameters in your analysis functions.


sub foobaricate {

  ## generally, we do not change modes unless there is data.
  ## exceptions include things like the prefernces and key bindings,
  ## which are data-independent
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");

  ## this is a way of testing the current list of data groups for some
  ## necessary property.  for the demo, this will just be the list of
  ## groups
  # my @keys = ();
  # foreach my $k (&sorted_group_list) {
  #   ($groups{$k}->{is_xmu}) and push @keys, $k;
  # };
  # Echo("You need two or more xmu groups to foobar"), return unless ($#keys >= 1);
  my @keys = &sorted_group_list;

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters, as in the commented out
  ## example
  my %foobar_params;
  $foobar_params{string}       = "Hi mom!";
  $foobar_params{boolean}      = 1;
  ## $foobar_params{blah}        = $config{foobar}{blah};

  ## let's just assume the first group is the standard and the second
  ## is the unknown
  $foobar_params{standard}     = $keys[0];
  $foobar_params{standard_lab} = $groups{$keys[0]}->{label};

  ## you probably do not want the standard and the unknown to be the
  ## same group
  set_properties(1, $keys[1], 0) if ($current eq $keys[0]);
  $foobar_params{unknown}      = $current;

  ## you may wish to provide a better guess for which should be the
  ## standard and which the unknown.  you may also want to adjust the
  ## view of the groups list to show the unknown -- the following
  ## works...
  my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
  ($here < 0) and ($here = 0);
  my $full = ($list->bbox(@skinny_list))[3] + 5;
  $list -> yview('moveto', $here/$full);


  ## The Athena standard for analysis chores that need a specialized
  ## plotting range is to save the plotting range from the main view
  ## and restore it when the main view is restored
  # my @save = ($plot_features{emin}, $plot_features{emax});
  # $plot_features{emin} = $config{foobar}{emin};
  # $plot_features{emax} = $config{foobar}{emax};

  ## these two global variables must be set before this view is
  ## displayed.  these are used at the level of set_properties to
  ## perform chores appropriate to this dialog when changing the
  ## current group
  $fat_showing = 'demo';
  $hash_pointer = \%foobar_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $foobar = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$foobar -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $foobar;

  ## the standard label along the top identifying this analysis chore
  $foobar -> Label(-text=>"Foobaricate your data",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## at this point it is common to make an optionmenu defining the
  ## standard for this data analysis chore and a label identifying
  ## which data group is currently being work on (i.e. the one
  ## highlighted in orange in the groups list)

  ## a good solution to organizing widgets is to stack frames, so
  ## let's make a frame for the standard and the other.  note that the
  ## "labels" are actually flat buttons which display hints in the
  ## echo area
  my $frame = $foobar -> Frame(-borderwidth=>2, -relief=>'sunken')
    -> pack(-side=>'top', -fill=>'x');
  $frame -> Button(-text=>"Standard: ", @label_button,
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   -command=>[\&Echo, "The spectrum serving as the foobarication standard."]
		  )
    -> grid(-row=>0, -column=>0, -sticky=>'e', -ipady=>2);
  my $menu = $frame -> Optionmenu(-textvariable => \$foobar_params{standard_lab},
				  -borderwidth=>1, )
    -> grid(-row=>0, -column=>1, -sticky=>'w');
  foreach my $s (@keys) {
    $menu -> command(-label => $groups{$s}->{label},
		     -command=>sub{$foobar_params{standard}=$s;
				   $foobar_params{standard_lab}=$groups{$s}->{label};
				   ## do the analysis chore
				 });
  };

  ## the group for alignment is the current group in the group list.
  ## note that the key for the %widget hash identifies the analysis
  ## chore.  this will make searches through this hash much easier in
  ## other parts Athena -- it's a good convention to stick to
  $frame -> Button(-text=>"Other: ",
		   -foreground=>$config{colors}{activehighlightcolor},
		   -activeforeground=>$config{colors}{activehighlightcolor},
		   @label_button,
		   -command=>[\&Echo, "The group currently selected for foobarication."]
		  )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -ipady=>2);
  $widget{foobar_unknown} = $frame -> Label(-text=>$groups{$current}->{label},
					    -foreground=>$config{colors}{button})
    -> grid(-row=>1, -column=>1, -sticky=>'w', -pady=>2, -padx=>2);



  ## this is a spacer frame which pushes all the widgets to the top
  $foobar -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $foobar -> Button(-text=>'Return to the main window',  @button_list,
		    -background=>$config{colors}{background2},
		    -activebackground=>$config{colors}{activebackground2},
		    -command=>sub{## clean-up chores, for instance you
                                  ## may need to toggle update_bkg or
                                  ## one of the others

		                  ## restore the plot ranges is they
		                  ## were changed
		                  ## finally restore the main view
		                  &reset_window($foobar, "foobarication", 0);
		                  #&reset_window($foobar, "foobarication", \@save);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $foobar -> Button(-text=>'Document section: foobaricating data', @button_list,
		   -command=>sub{Echo("Display this document section");
				 ## get rid of the preceding line
				 ## and uncomment the next line
				 ## pod_display("process::foobar.pod");
			       })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  ## now begin setting up the widgets you need for your new analysis
  ## feature

  ## now a new frame for our two dummy widgets
  $frame = $foobar -> Frame(-borderwidth=>2, -relief=>'sunken')
    -> pack(-side=>'top', -fill=>'x');
  $widget{foobar_string} = $frame -> Entry(-width=>20,
					   -textvariable=>\$foobar_params{string})
    -> pack(-side=>'top');
  $widget{foobar_boolean} = $frame -> Checkbutton(-text=>"Do super foobarication",
						  -variable=>\$foobar_params{boolean})
    -> pack(-side=>'bottom');



  ## do you need to run one of your analysis subroutines immediately?
  ## now is a good time...

  ## and finally....
  $top -> update;

};


## END OF DEMO SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2009 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  writing and reading macros


sub setup_macro {
  my $instructions = <<EOH
To begin recording a macro, click the button below.  All subsequent
calls to ifeffit will be recorded.  When you have performed all the
ifeffit operations you wish to record, press the \"Done\" button and
you will be prompted for a filename in which to save the macro.

Data processing chores which involve altering the data, e.g.
deglitching and truncating, will not record properly as macros.
EOH
  ;

  $notes{macro} -> tagConfigure('inst', -wrap=>'word');
  $notes{macro} -> insert('end', $instructions, "text");

  my $doneline  = $notecard{macro} -> Frame(qw/-relief flat -borderwidth 2/)
    -> pack(qw/-fill x -side bottom/);
  my $startline = $notecard{macro} -> Frame(qw/-relief groove -borderwidth 2/)
    -> pack(qw/-fill x -side bottom/);

  my $rectext = $startline -> Label(-text=>"Recording macro...", -justify=>'center');
  my $start;
  $start = $startline -> Button(-text=>'Start recording',  @button_list,
				-command=>sub{$start->packForget();
					      $rectext-> pack(-expand=>1, -fill=>'x', -pady=>4);
					      ($dmode & 8) or ($dmode += 8);})
    -> pack(-expand=>1, -fill=>'x');

  my $done = $doneline
    -> Button(-text=>'Done',  @button_list,
	      -command=>sub{$rectext -> packForget();
			    $start   -> pack(-expand=>1, -fill=>'x');
			    ($dmode & 8) and ($dmode -= 8);
			    &save_macro;})
    -> pack(-expand=>1, -fill=>'x');
};

sub save_macro {
  return unless @macro_buffer;
  local $Tk::FBox::a;
  local $Tk::FBox::b;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [['Ifeffit macro files', '.ifm'],
	       ['All Files', '*'],];
  my $file = $top -> getSaveFile(-defaultextension=>'ifm',
				 -filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>'athena.ifm',
				 -title => "Athena: Save Ifeffit macro");
  if ($file) {
    my ($name, $pth, $suffix) = fileparse($file);
    $current_data_dir = $pth;
    #&push_mru($file, 0);
    open MAC, '>'.$file or do {
      Error("You cannot write macro to \"$file\"."); return
    };
    print MAC "## Ifeffit macro file recorded using Athena $VERSION\n\n";
    my $macros = write_macros();
    print MAC $macros;
    map {print MAC $_} @macro_buffer;
    close MAC;
    @macro_buffer = ();
  };
};

sub load_macro {
  local $Tk::FBox::a;
  local $Tk::FBox::b;
  my $path = $current_data_dir || Cwd::cwd;
  my $types = [['Ifeffit macro files', '.ifm'],
	       ['All Files', '*'],];
  my $file = $top -> getOpenFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -title => "Athena: Load macro");
  if ($file) {
    my ($name, $pth, $suffix) = fileparse($file);
    $current_data_dir = $pth;
    #&push_mru($file, 0);
    open MAC, $file or die "Could not open $file for reading macro\n";
    while (<MAC>) {
      next if (/^\s*\#/);
      next if (/^\s*$/);
      if ($_ =~ /^\s*read_data/) {
	my ($file, $group);
	($_ =~ /file\s*=\s*([^ \t,]*)/) and ($file = $1);
	($_ =~ /group\s*=\s*([^ \t,]*)/) and ($group = $1);
	fill_skinny($list, $file, $group);
      } else {
	$groups{$current}->dispose($_, $dmode);
      };
    };
    close MAC;
  };
};

sub write_macros {
  my $string = "
macro startup
  \"Athena startup message, used to set character size and font\"
  set(startup.x = range(0.1,1,0.1), startup.y = zeros(10))
  newplot(startup.x, startup.y, nogrid, ymin=0, ymax=1, color=black, charsize=$config{plot}{charsize}, charfont=$config{plot}{charfont})
  plot_text(0.4, 0.5, text=\"Welcome to Athena\")
  erase \@group startup
end macro

## macro for drawing markers (for e0 and the like)
macro  pmarker d.x d.y x style color yoffset
  \"plot a marker at X given D.X and D.Y and YOFFSET with STYLE, and COLOR\"
  set(p___y = interp(\$1, \$2, \$3) + \$6)
  plot_marker(\$3, p___y, \$4, color=\$5)
end macro

## making a step function
macro step x.array shift x a.step
  \"Return A.STEP function centered at X with X.ARRAY as the x-axis and a SHIFT energy shift\"
  set(t___oss.x     = \$1 + \$2,
      n___step      = nofx(t___oss.x, \$3) - 1,
      n___points    = npts(\$1) - n___step,
      t___oss.zeros = zeros(n___step),
      t___oss.ones  = ones(n___points),
      \$4 = join(t___oss.zeros, t___oss.ones) )
end macro


## log-ratio/phase difference macros:

macro do_lograt stan unknown qmin qmax npi
  \"Do log-ratio/phase-difference analysis between STAN and UNKNOWN between QMIN and QMAX\"

  ## do log-ratio fit
  guess(c___0 = 1, c___2 = 0, c___4 = 0)
  def(c___.ratio = ln(\$2.chiq_mag/\$1.chiq_mag),
      c___.even  = c___0 - 2*c___2*\$1.q^2 + (2/3)*c___4*\$1.q^4,
      c___.resev = c___.ratio - c___.even)
  minimize(c___.resev, x=\$1.q, xmin=\$3, xmax=\$4)
  set(c___0 = c___0, c___2 = c___2, c___4 = c___4)

  ## do phase difference fit
  guess(c___1 = 0, c___3 = 0)
  def(c___.diff = \$2.chiq_pha - \$1.chiq_pha,
      c___.odd = 2*c___1*\$1.q - (4/3) * c___3*\$1.q^3 + \$5*2*pi,
      c___.resod = c___.diff - c___.odd)
  minimize(c___.resod, x=\$1.q, xmin=\$3, xmax=\$4)
  set(c___1  = c___1, c___3  = c___3)
end macro

macro plot_lograt stan stan_lab unknown_lab qmax
  \"Plot log ratio and fit for STAN out to QMIN\"
  newplot((\$1.q)**2, c___.ratio, xmax=\$4**2, title=\"log-ratio between \$3 and \$2\",
          xlabel=\"k\\u2\\d (\\A\\u-2\\d)\", ylabel=\"log-ratio\", key=data)
  plot((\$1.q)**2, c___.even, key=fit)
end macro

macro plot_phdiff stan stan_lab unknown_lab qmax
  \"Plot phase difference and fit for STAN out to QMIN\"
  newplot(\$1.q, c___.diff, xmax=\$4, title=\"phase-difference between \$3 and \$2\",
          xlabel=\"k (\\A\\u-1\\d)\", ylabel=difference, key=data)
  plot(\$1.q, c___.odd, key=fit)
end macro

macro clean_lograt
  erase c___0 c___1 c___2 c___3 c___4
  erase \@group c___
end macro

macro fix_chik
   \"repair chi(k) data group that is not on a uniform k grid\"
   set(fix___a.k   = range(0, ceil(\$1.k), 0.05))
   set(fix___floor = floor(\$1.k) - 0.05)
   set(fix___a.kk  = range(0, fix___floor, 0.05))
   set(fix___n     = npts(fix___a.kk))
   set(fix___a.cc  = zeros(fix___n))
   set(fix___a.x   = join(fix___a.kk, \$1.k))
   set(fix___a.y   = join(fix___a.cc, \$1.chi))
   set(fix___a.chi = rebin(fix___a.x, fix___a.y, fix___a.k))
   set(\$1.k         = fix___a.k)
   set(\$1.chi       = fix___a.chi)
   erase \@group fix___a fix___floor fix___n
end macro

## end of Athena's macros
##
##
";
  return $string;
};

##        xmin=floor(\$1),xmax=ceil(\$1),
##        ymin=floor(\$2),ymax=ceil(\$2) )

## END OF MACROS SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  the informational palettes


## $group_title_##
sub update_titles {
  my $group = $_[0];

};

sub raise_palette {
  ($update->state() eq "normal") ? $update->raise : $update->deiconify && $update->raise;
  $notebook->raise($_[0]);
};


sub setup_data {
  #my $this = $_[0] || $groups{$current}->{file};
  my $this = $groups{$current}->{file};
  Echo('No data!'), return unless ($this);
  Echo("The Default Parameters have no associated data"), return if ($this eq "Default Parameters");
  Echo("The current group has no associated file"), return unless (-e $this);
  if (Ifeffit::Files->is_record($this)) {
    Error("This data is from a project file and may not be edited via the data palette.");
    $notes{data} -> insert('end', 'This data is from a project file and may not be edited this way.', "text");
    $update->deiconify;
    $notebook->raise('data');
    $top->update;
    return;
  };
  $update->deiconify;
  $notebook->raise('data');
  $current_file = $this;
  #my $file = $_[0] || $groups{$current}->{file};
  my $file = $groups{$current}->{file};
  open F, $file or die "Could not open $file\n";
  $notes{data} -> configure(-state=>'normal');
  $notes{data} -> delete(qw/1.0 end/);
  while (<F>) {
    s/\r//;
    $notes{data} -> insert('end', $_, "text");
  };
  ## this was a stab at putting the view at the beginning of the
  ## data. it cause Athena to crash in certain situations.  that
  ## doesn't seem like a good idea...

#  if ($_[0]) {
##     my $comm = Ifeffit::get_string('$commentchar');
##     my $lab  = (split(" ",Ifeffit::get_string('$column_label')))[0];
##     my $regex = "^[ \\t$comm]*$lab";
##     ##print $regex, $/;
##     my $index = $notes{data} -> search('-regexp', $regex, '1.0', 'end');
##     $index = $notes{data} -> index($index);
##     my @parts = split(/\./, $index);
##     $index = $parts[0] - 2;
##     $index .= ".$parts[1]";
##     $notes{data} -> yview($index);
##     $top -> update;
#  };
  close F;
};


## what about records and chi data?
sub save_and_reload {
  Echo("Cannot save and reload, \"$groups{$current}->{label}\" is frozen."), return if ($groups{$current}->{frozen});
  Echo("Save and reload does not yet work for records"), return if $groups{$current}->{is_rec};
  my $how = $_[0];
  my $n = 3;
  my $tmp = "." x $n . "athena.tmp"; # this will eventually find an
  while (-f $tmp) {		     # unused temporary file name
    ++$n;
    $tmp = "." x $n . "athena.tmp";
  };
  my $file = $tmp;
  if ($how) {
    #local $Tk::FBox::a;
    #local $Tk::FBox::b;
    my $path = $current_data_dir || Cwd::cwd;
    my $f = basename($groups{$current}->{file});
    my $types = [['All Files', '*'], ['Data Files', '.dat']];
    $file = $top -> getSaveFile(-filetypes=>$types,
				#(not $is_windows) ?
				#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-initialfile=>$f,
				-title => "Athena: Save edited data");
    return unless ($file and (-e $file));
    &push_mru($file, 1);
  };
  open D, '>'.$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  print D $notes{data} -> get(qw/1.0 end/);
  close D;
  my ($e, $x) = ($groups{$current}->{en_str}, $groups{$current}->{mu_str});
  $groups{$current} -> dispose("read_data(file=\"$file\", group=$current)\n", $dmode);
 SWITCH: {
    $groups{$current}->{is_xmu} and do {
      $groups{$current} -> dispose("set($current.energy = $e, $current.xmu = $x)\n", $dmode);
      $groups{$current} -> make(update_bkg=>1);
      $groups{$current} -> plotE('emz',$dmode,\%plot_features, \@indicator);
      $last_plot = 'e';
      $last_plot_params = [$current, 'group', 'e', 'emz'];
      last SWITCH;
    };
    $groups{$current}->{is_chi} and do {
      $groups{$current} -> dispose("set($current.k = $e, $current.chi = $x)\n", $dmode);
      $groups{$current} -> make(update_chi=>1);
      $groups{$current} -> plotk('kw',$dmode,\%plot_features, \@indicator);
      $last_plot = 'k';
      $last_plot_params = [$current, 'group', 'k', 'kw'];
      last SWITCH;
    };
    ## rsp? qsp?
  };
  if ($how) {
    $groups{$current} -> make(file=>$file);
  } else {
    unlink $file;
  };
};

## END OF PALETTES SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  Athena's interactions with the Ifeffit/PGPLOT plotting system.

sub plot_merge {
  my ($group, $space) = @_;
  my $color = $plot_features{c1};
  my $label = $groups{$group}->{label};
  my $propsp = "color=$color, key=\"$label+std.dev.\", style=lines";
  my $propsm = "color=$color, key=\"$label-std.dev.\", style=lines";
  my $kstr = ($plot_features{k_w} eq 'w') ? 'kw' : 'k'.$plot_features{k_w};
  my $kexp = ($plot_features{k_w} eq 'w') ? $groups{$group}->{fft_arbkw} : $plot_features{k_w};
  my $yoffset = $groups{$group}->{plot_yoffset};
 PLOT: {
    ($space eq 'k') and do {
      if ($config{merge}{plot} eq 'stddev') {
	$groups{$group} -> plotk($kstr,$dmode,\%plot_features, \@indicator);
	my $string = "plot($group.k, \"($group.chi+$group.stddev)*$group.k**$kexp+$yoffset\", $propsp)";
	$groups{$group} -> dispose($string, $dmode);
	$string = "plot($group.k, \"($group.chi-$group.stddev)*$group.k**$kexp+$yoffset\", $propsm)";
	$groups{$group} -> dispose($string, $dmode);
      } else {
	&plot_marked_k;
      };
      $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      last PLOT;
    };
    ($space =~ /[end]/) and do {
      if ($config{merge}{plot} eq 'stddev') {
	my $str = ($space eq 'e') ? 'em' : 'emn';
	$groups{$group} -> plotE($str,$dmode,\%plot_features, \@indicator);
	my $esh = $groups{$group}->{bkg_eshift};
	my $suff = ($space eq 'e') ? 'xmu' : 'norm';
	($suff = "det") if ($space eq 'd');
	($groups{$group}->{is_nor}) and ($suff = 'xmu');
	my $string = "plot($group.energy+$esh, \"$group.$suff+$group.stddev+$yoffset\", $propsp)";
	$groups{$group} -> dispose($string, $dmode);
	$string = "plot($group.energy+$esh, \"$group.$suff-$group.stddev+$yoffset\", $propsm)";
	$groups{$group} -> dispose($string, $dmode);
      } else {
	&plot_marked_e;
      };
      $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      last PLOT;
    };
    ($space =~ /[rq]/) and do {
      if ($config{merge}{plot} eq 'stddev') {
	Echo("Plotting merge+std.dev. in R and q spaces does not work yet.");
      } elsif ($space eq 'r') {
	&plot_marked_r;
	$plotsel->raise('r') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      } elsif ($space eq 'q') {
	&plot_marked_q;
	$plotsel->raise('q') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
      };
      last PLOT;
    };
  };

};


sub plot_i0 {
  my $plot_mu = $_[0];
  $top -> Busy;
  my $with  = ($plot_mu) ? " $groups{$current}->{label} and" : "";
  my $how   = ($plot_mu) ? " (scaled to the size of mu)" : " for $groups{$current}->{label}";
  Echonow("Plotting$with I0$how ...");
  my $plot  = ($plot_mu) ? "plot" : "newplot";
  my $title = ($plot_mu) ? "" : ",xlabel=\"energy (eV)\", ylabel=I0, title=\"I0 of $groups{$current}->{label}\"";
  my ($scale, $color) = ("", $config{plot}{c0});
  my $i0 = $groups{$current}->{i0};
  my $eshift = $groups{$current}->{bkg_eshift};
  if ($plot_mu) {
    $groups{$current}->dispose("## plotting data and I0, scaled to the size of mu(E)\n", $dmode);
    $groups{$current}->plotE('em', $dmode, \%plot_features, \@indicator);
    $color = $config{plot}{c1};
    $groups{$current}->dispose("set ___x = ceil($current.xmu) / ceil($i0)\n", $dmode);
    $scale = sprintf("%.6g*", abs(Ifeffit::get_scalar("___x")));
  };
  my $cmd = "$plot(\"$current.energy+$eshift\", $scale$i0, key=I0, color=$color,\n";
  $cmd   .= " " x length($plot) . " style=lines$title,\n";
  my ($emin, $emax) = ($plot_features{emin}+$groups{$current}->{bkg_e0}, $plot_features{emax}+$groups{$current}->{bkg_e0});
  $cmd   .= " " x length($plot) . " xmin=$emin, xmax=$emax)\n";
  $groups{$current}->dispose($cmd, $dmode);

  if ($indicator[0]) {
    my $eshift = $groups{$current}->{bkg_eshift};
    $groups{$current}->dispose("set(i___ndic.y = $scale$i0, i___ndic.x = $current.energy+$eshift)");
    my @x = Ifeffit::get_array("i___ndic.x");
    my @y = Ifeffit::get_array("i___ndic.y");
    my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$current}->{bkg_e0});
    #print join("|", $not_data, $ymin, $ymax), $/;
    #(($ymin, $ymax) = ($plot_scale*$ymin, $plot_scale*$ymax)) if ($not_data);
    my $diff = $ymax-$ymin;
    $ymin -= $diff/20;
    $ymax += $diff/20;
    foreach my $i (@indicator) {
      last if ($i =~ /^0$/);
      next if ($i =~ /^1$/);
      next if (lc($i->[1]) =~ /[r\s]/);
      my $val = $i->[2];
      ($val = $groups{$current}->k2e($val)+$groups{$current}->{bkg_e0}) if (lc($i->[1]) =~ /[kq]/);
      next if ($val < 0);
      $groups{$current}->plot_vertical_line($val, $ymin, $ymax, $dmode, "", 0, 0, 1)
    };
  };


  $last_plot='e';
  $top -> Unbusy;
  Echonow("Plotting$with I0$how ... done!");
};

sub plot_i0_marked {
  my $plot = "newplot";
  my $i = 0;
  my $title = ",xlabel=\"energy (eV)\", ylabel=I0, title=\"I0 of marked groups\"";
  my ($yn, $yx) = (1e10, -1e10);
  foreach my $k (&sorted_group_list) {
    next unless $marked{$k};
    next unless $groups{$k}->{i0};
    my $eshift = $groups{$k}->{bkg_eshift};
    my $key = $groups{$k}->{label};
    my $color = $config{plot}{"c".$i};
    my ($emin, $emax) = ($plot_features{emin}+$groups{$k}->{bkg_e0}, $plot_features{emax}+$groups{$k}->{bkg_e0});
    my $limits = ($plot eq "newplot") ? ",\n        xmin=$emin, xmax=$emax" : "";
    $groups{$current}->dispose("$plot(\"$k.energy+$eshift\", $groups{$k}->{i0}, key=$key, color=$color, style=lines$title$limits)\n", $dmode);
    $plot = "plot";
    $title = "";
    ++$i;
    ($i = 0) if ($i > 9); # wrap colors

    $groups{$k}->dispose("set(i___ndic.y = $groups{$k}->{i0}, set i___ndic.x = $current.energy+$eshift)");
    my @x = Ifeffit::get_array("i___ndic.x");
    my @y = Ifeffit::get_array("i___ndic.y");
    my ($ymin, $ymax) = Ifeffit::Group->floor_ceil(\@x, \@y, \%plot_features, 'e', $groups{$k}->{bkg_e0});
    ($yn = $ymin) if ($ymin<$yn);
    ($yx = $ymax) if ($ymax>$yx);
  };
  my $diff = $yx-$yn;
  $yn -= $diff/20;
  $yx += $diff/20;
  foreach my $i (@indicator) {
    last if ($i =~ /^0$/);
    next if ($i =~ /^1$/);
    next if (lc($i->[1]) =~ /[r\s]/);
    my $val = $i->[2];
    ($val = $groups{$current}->k2e($val)+$groups{$current}->{bkg_e0}) if (lc($i->[1]) =~ /[kq]/);
    next if ($val < 0);
    $groups{$current}->plot_vertical_line($val, $yn, $yx, $dmode, "", 0, 0, 1)
  };
  $last_plot='e';
};

sub redo_plot {
  Echo ("You have not yet plotted anything"), return unless $last_plot_params;
  my ($curr, $type, $sp, $str) = @$last_plot_params;
 SWITCH: {			# dispatch plot request to the correct method
    $groups{$curr}->plot_marked($str,$dmode,\%groups,\%marked,\%plot_features, $list, \@indicator), last SWITCH
      if ($type eq 'marked');
    $groups{$curr}->plotE($str,$dmode,\%plot_features, \@indicator), last SWITCH if ($sp eq 'e');
    $groups{$curr}->plotk($str,$dmode,\%plot_features, \@indicator), last SWITCH if ($sp eq 'k');
    $groups{$curr}->plotR($str,$dmode,\%plot_features, \@indicator), last SWITCH if ($sp eq 'r');
    $groups{$curr}->plotq($str,$dmode,\%plot_features, \@indicator), last SWITCH if ($sp eq 'q');
  };
};

sub replot {
  Echo('No data'), return unless $current;
  my $mode = $_[0];		# 0=replot, 1=write gif, 2=write ps,
                                # 3=send to printer
  Echo("You have not yet plotted anything."), return 0 unless ($Ifeffit::Group::last_plot);
  my ($title, $suf, $dev);
 SWITCH: {
      ($mode eq 'replot') and do {
	$setup->dispose($Ifeffit::Group::last_plot, 1);
	Echo("Unzoomed.");
	return;
      };
      ($mode =~ /(gif|png|ppm)/) and do {
	($title, $suf, $dev) = ('Athena: '.uc($1).' file name', $1, $mode );
	last SWITCH;
      };
      ($mode =~ /ps/) and do {
	($title, $suf, $dev) = ('Athena: Postscript file name', 'ps', $mode);
	last SWITCH;
      };
      ($mode =~ /latex/) and do {
	($title, $suf, $dev) = ('Athena: LaTeX picture mode file name', 'tex', $mode);
	last SWITCH;
      };
      ($mode eq 'print') and do {
	($title, $suf, $dev) = ('', 'ps', $config{general}{ps_device});
	last SWITCH;
      };
      ($title, $suf, $dev) = ('Athena: Image file name', 'img', $mode);
    };
  my $path = $current_data_dir || Cwd::cwd;
  if ($mode eq 'print') {
    if ($is_windows) {
      Echo("Printing under Windows is not yet supported");
    } else {
      ## this is alarmingly crufty!
      my $tmp = '...athena.tmp';
      $setup->dispose("plot(device=\"$dev\", file=\"$tmp\")\n", 7);
      local $| = 1;
      Echo("Sending image to printer with " .
	   $config{general}{print_spooler});
      open OUT, "| ".$config{general}{print_spooler} or
	die "could not open pipe to ".$config{general}{print_spooler}."\n";
      open IN, $tmp or die "could not open temp file for printing";
      while (<IN>) { print OUT; };
      close IN; close OUT; unlink $tmp;
      Echo("Image spooled.");
    };
    return;
  } else {
    ##local $Tk::FBox::a;
    ##local $Tk::FBox::b;
    my $types = [["$suf image files", $suf],
		 ['All Files', '*'],];
    my $file = $top -> getSaveFile(-defaultextension=>$suf,
				   -filetypes=>$types,
				   ##(not $is_windows) ?
				   ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				   -initialdir=>$path,
				   -initialfile=>"athena.$suf",
				   -title => $title);
    if ($file) {
      ## make sure I can write to $file
      open F, ">".$file or do {
	Error("You cannot write to \"$file\"."); return
      };
      close F;
      my ($name, $path, $suffix) = fileparse($file);
      $current_data_dir = $path;
      Echo("saving image to $file");
      $setup->dispose("plot(device=\"$dev\", file=\"$file\")\n", 7);
      #$setup->dispose("plot(device=\"/xserve\", file=\"\")\n", 7);
    };
  };
};


sub autoreplot {
  ## this could be a direct call or it could be a callback from some widget
  my $arg = (ref($_[0]) =~ /Tk/) ? $_[1] : $_[0];
  #print join(" ", @_), $/, "arg=$arg\n";
  ## replot a specific space
  plot_current_e(), return if (lc($arg) eq 'e');
  plot_current_k(), return if (lc($arg) eq 'k');
  plot_current_r(), return if (lc($arg) eq 'r');
  plot_current_q(), return if (lc($arg) eq 'q');
  ## replot the most recent space
  plot_current_e(), return if ($last_plot eq 'e');
  plot_current_k(), return if ($last_plot eq 'k');
  plot_current_r(), return if ($last_plot eq 'r');
  plot_current_q(), return if ($last_plot eq 'q');
};



sub pluck {
  my $widg = $_[0];
  my $parent = $_[1] || $top;
  my $this = $current || "Default Parameters";
  Echo("You have not made a plot yet."), return 0 unless ($last_plot);
  if ($widg =~ /^lr/) {
    1;
  } elsif ($widg =~ /^pp/) {
    1;
  } elsif (($last_plot =~ /[ek]/) and (($widg =~ /^bft/) or ($widg eq 'bkg_rbkg'))) {
    Echonow("You cannot pluck an R value from the last plot.");
    return 0;
  ## } elsif (($last_plot eq 'ke') and ($widg !~ /bkg/)) {
  ##   Echonow("Your last plot was an energy plot.");
  ##   return 0;
  } elsif (($last_plot eq 'k') and ($widg =~ /pre/)) {
    Echonow("You cannot pluck an pre-edge parameter value from a k plot.");
    return 0;
  } elsif (($last_plot eq 'r') and (($widg !~ /^bft/) and ($widg ne 'bkg_rbkg'))) {
    Echonow("Your last plot was an R plot.");
    return 0;
  };
  Echonow("Select a value for $widg from the plot...");
  my ($cursor_x, $cursor_y) = (0,0);
  my $to_grab = $grab{$widg} || $parent;
  $to_grab -> grab();
  $groups{$this}->dispose("cursor(crosshair=true)\n", 1);
  ($cursor_x, $cursor_y) = (Ifeffit::get_scalar("cursor_x"),
			    Ifeffit::get_scalar("cursor_y"));
  $to_grab -> grabRelease();
  my $value;
  if ($widg =~ /^(bkg_(e0|nor[12]|pre[12]|spl(1e|2e)))$/) { # need an E value
    if (($last_plot eq 'e') or ($last_plot eq 'ke')) {
      $value = $cursor_x;
    } else {
      $value = $groups{$this}->k2e($cursor_x);
    };
    ($widg !~ /e0/) and $value -= $groups{$this}->{bkg_e0};
  } elsif ($widg =~ /^(deg|diff|etrun|lcf|peak)/) {
    $value = $cursor_x;
  } elsif ($widg =~ /^(bkg_spl[12]|fft_km(ax|in))$/) {      # need a k value
    if (($last_plot eq 'e') or ($last_plot eq 'ke')) {
      $value = $groups{$this}->e2k($cursor_x);
      ($widg =~ /(nor|pre)/) and $value -= $groups{$this}->{bkg_e0};
    } else {
      $value = $cursor_x;
    };
  } elsif ($widg =~ /^(b(ft_rm(ax|in)|kg_rbkg))$/) {        # need an R value
    $value = $cursor_x;
  } elsif ($widg =~ /^lr/) {        # need an R value
    $value = $cursor_x;
  } elsif ($widg =~ /^pp_(.+)/) {
    $value = sprintf("%.3f", $cursor_x);
    $preprocess{$1} = $value;
    Echonow("Plucked the value of $value for $widg.");
    return 1;
  } else {
    return -1;
  };
  $value = sprintf("%.3f", $value);
  set_variable($widg, $value, 1);
  my $v = $groups{$this}->{$widg};
  $widget{$widg} -> configure(-validate=>'none');
  $widget{$widg} -> delete(qw/0 end/);
  $widget{$widg} -> insert(0, $v);
  $widget{$widg} -> configure(-validate=>'key');
  ##$parent->raise;
  my $how = $_[2] || "e";
  ($how = 'r') if ($widg =~ /^fft/);
  ($how = 'q') if ($widg =~ /^bft/);
  $widget{peak_plot}->invoke if ($widg =~ /^peak/);
  autoreplot($how) unless
      (
       (($widg =~ /^fft/) and not ($config{fft}{pluck_replot}))
       or
       ($widg =~ /^(peak)/)
       or
       ($widg =~ /^(lcf)/)
      );
  Echonow("Plucked the value of $v for $widg.");
  #($widg =~ /^deg/) and $groups{$current} -> plotE('emg',$dmode,\%plot_features, \@indicator);
  return 1;
};


sub zoom {
  if ($fat_showing ne 'teach_ft') {
    Echo('No data'), return unless $current;
    Echo("You have not yet plotted anything."), return unless $last_plot;
  };
  Echonow('Click corners to zoom');
  my $mode = $dmode;
  ($mode & 8) and ($mode -= 8);
  $setup->dispose('zoom(show)', $mode);
  Echo('Zooming done!');
};

sub cursor {
  Echo('No data'), return unless $current;
  Echo("You have not yet plotted anything."), return unless $last_plot;
  my $old = $echo_pause;
  $echo_pause = 0;
  Echonow('Click on a point');
  $echo_pause = $old;
  my $mode = $dmode;
  ($mode & 8) and ($mode -= 8);
  $setup->dispose('cursor(show, crosshair=true)', $mode);
  Echonow(sprintf("You selected  x=%f   y=%f",
		  Ifeffit::get_scalar("cursor_x"),
		  Ifeffit::get_scalar("cursor_y")));
};


## return 1 if all relevant ranges are correct, return 0 and do an
## Echo if there is a problem
sub verify_ranges {
  my ($this, $space, $multi) = @_;
  if ($groups{$this}->{is_xmu} and (not $groups{$this}->{is_nor}) and
      ($groups{$this}->{bkg_pre1} > $groups{$this}->{bkg_pre2})) {
    Echo("ERROR: The minimum value of the pre-edge range exceeds the maximum value.");
    set_properties (1, $this, 0) if ($multi);
    return 0;
  };
  if ($groups{$this}->{is_xmu} and (not $groups{$this}->{is_nor}) and
      ($groups{$this}->{bkg_nor1} > $groups{$this}->{bkg_nor2})) {
    Echo("ERROR: The minimum value of the normalization range exceeds the maximum value.");
    set_properties (1, $this, 0) if ($multi);
    return 0;
  };
  if ($groups{$this}->{is_xmu} and ($groups{$this}->{bkg_spl1} > $groups{$this}->{bkg_spl2})) {
    Echo("ERROR: The minimum value of the spline range exceeds the maximum value.");
    set_properties (1, $this, 0) if ($multi);
    return 0;
  };
  return 1 if $groups{$this}->{is_xanes};
  return 1 if $groups{$this}->{not_data};
  if (($space =~ /[rq]/) and (not $groups{$this}->{is_qsp})) {
    if ($groups{$this}->{fft_kmin} > $groups{$this}->{fft_kmax}) {
      Echo("ERROR: The minimum value of the forward Fourier transform range exceeds the maximum value.");
      set_properties (1, $this, 0) if ($multi);
      return 0;
    };
  };
  return 1 if $groups{$this}->{is_qsp};
  if ($space =~ /q/) {
    if ($groups{$this}->{bft_rmin} > $groups{$this}->{bft_rmax}) {
      Echo("ERROR: The minimum value of the backward Fourier transform range exceeds the maximum value.");
      set_properties (1, $this, 0) if ($multi);
      return 0;
    };
  };
  return 1;
};

sub plot_current_e {
  my $str = "e";
  Echo('No data!'), return unless ($current);
  return unless &verify_ranges($current, 'e');
  $top -> Busy(-recurse=>1,);
  update_hook();
  map {$str .= $plot_features{$_}} (qw/e_mu e_mu0 e_pre e_post e_norm e_der/);
  ($str eq "e")  and ($str = "emz");
  ($str eq "en") and ($str = "emzn");
  ($str eq "ed") and ($str = "emdsss");
  ($str =~ "d")  and ($str .= "s" x $plot_features{smoothderiv});
  &set_key_params;
  $groups{$current}->plotE($str,$dmode,\%plot_features, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'e');
  $last_plot='e';
  $last_plot_params = [$current, 'group', 'e', $str];
  $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was in Energy");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'normal');
  };
  Error("The edge step is negative!  You probably need to adjust the normalization parameters.")
    if ($groups{$current}->{bkg_step} < 0);
  $top->Unbusy;
};


sub plot_current_k {
  my $str = "k";
  Echo('No data!'), return unless ($current);
  return unless &verify_ranges($current, 'k');
  $top -> Busy(-recurse=>1,);
  update_hook();
  map {$str .= $plot_features{$_}} (qw/k_w k_win/);
  &set_key_params;
  $groups{$current}->plotk($str,$dmode,\%plot_features, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'k');
  $last_plot='k';
  $last_plot_params = [$current, 'group', 'k', $str];
  $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was in k");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'normal');
  };
  Error("The edge step is negative!  You probably need to adjust the normalization parameters.")
    if ($groups{$current}->{bkg_step} < 0);
  $top->Unbusy;
};

sub plot_current_r {
  my $str = "r";
  Echo('No data!'), return unless ($current);
  return unless &verify_ranges($current, 'r');
  $top -> Busy(-recurse=>1,);
  update_hook();
  map {$str .= $plot_features{$_}} (qw/r_mag r_env r_re r_im r_pha r_win/);
  ($str eq "r") and ($str = "rm");
  &set_key_params;
  $groups{$current}->plotR($str,$dmode,\%plot_features, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'r');
  $last_plot='r';
  $last_plot_params = [$current, 'group', 'r', $str];
  $plotsel->raise('r') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was in R");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'normal');
  };
  Error("The edge step is negative!  You probably need to adjust the normalization parameters.")
    if ($groups{$current}->{bkg_step} < 0);
  $top->Unbusy;
};

sub plot_current_q {  # }
  my $str = "q";
  Echo('No data!'), return unless ($current);
  return unless &verify_ranges($current, 'q');
  $top -> Busy(-recurse=>1,);
  update_hook();
  map {$str .= $plot_features{$_}} (qw/q_mag q_env q_re q_im q_pha q_win/);
  ($str eq "q") and ($str = "qi");
  &set_key_params;
  $groups{$current}->plotq($str,$dmode,\%plot_features, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'q');
  $last_plot='q';
  $last_plot_params = [$current, 'group', 'q', $str];
  $plotsel->raise('q') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was in q");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'normal');
  };
  Error("The edge step is negative!  You probably need to adjust the normalization parameters.")
    if ($groups{$current}->{bkg_step} < 0);
  $top->Unbusy;
};


sub keyboard_plot {
  my $who = $top->focusCurrent;
  $multikey = "";
  Echo("Plot Current group: specify plot space (e k r q)");
  $echo -> focus();
  $echo -> grab;
  $echo -> waitVariable(\$multikey);
  $echo -> grabRelease;
  $who -> focus;
  Echo("$multikey is not a plot space!"), return unless (lc($multikey) =~ /^[ekqr]$/);
 SWITCH: {
    &plot_current_e, last SWITCH if (lc($multikey) eq 'e');
    &plot_current_k, last SWITCH if (lc($multikey) eq 'k');
    &plot_current_r, last SWITCH if (lc($multikey) eq 'r');
    &plot_current_q, last SWITCH if (lc($multikey) eq 'q');   # ,
  };
};


sub plot_marked_e {
  my $str = $plot_features{e_marked};
  Echo('No data!'), return unless ($current);
  $top -> Busy(-recurse=>1,);
  update_hook();
  &set_key_params;
  $groups{$current}->plot_marked($str, $dmode, \%groups, \%marked, \%plot_features, $list, \@indicator);
  &refresh_properties;
  $last_plot='e';
  $last_plot_params = [$current, 'marked', 'e', $str];
  $plotsel->raise('e') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was a marked plot");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'disabled');
  };
  my $bad_step = 0;
  foreach my $k (keys %marked) {
    next unless $marked{$k};
    ++$bad_step if ($groups{$k}->{bkg_step} < 0);
  };
  Error("The edge step of one or more groups is negative!  You probably need to adjust the normalization parameters.")
    if $bad_step;
  $top->Unbusy;
};

sub plot_marked_k {
  #my $str = $plot_features{k_w};
  my $str = $plot_features{kw};
  Echo('No data!'), return unless ($current);
  $top -> Busy(-recurse=>1,);
  update_hook();
  &set_key_params;
  $groups{$current}->plot_marked($str, $dmode, \%groups, \%marked, \%plot_features, $list, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'k');
  $last_plot='k';
  $last_plot_params = [$current, 'marked', 'k', $str];
  $plotsel->raise('k') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was a marked plot");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'disabled');
  };
  my $bad_step = 0;
  foreach my $k (keys %marked) {
    next unless $marked{$k};
    ++$bad_step if ($groups{$k}->{bkg_step} < 0);
  };
  Error("The edge step of one or more groups is negative!  You probably need to adjust the normalization parameters.")
    if $bad_step;
  $top->Unbusy;
};

sub plot_marked_r {
  #tie my $timer, 'Time::Stopwatch';
  my $str = $plot_features{r_marked};
  Echo('No data!'), return unless ($current);
  $top -> Busy(-recurse=>1,);
  update_hook();
  &set_key_params;
  $groups{$current}->plot_marked($str, $dmode, \%groups, \%marked, \%plot_features, $list, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'r');
  $last_plot='r';
  $last_plot_params = [$current, 'marked', 'r', $str];
  $plotsel->raise('r') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was a marked plot");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'disabled');
  };
  my $bad_step = 0;
  foreach my $k (keys %marked) {
    next unless $marked{$k};
    ++$bad_step if ($groups{$k}->{bkg_step} < 0);
  };
  Error("The edge step of one or more groups is negative!  You probably need to adjust the normalization parameters.")
    if $bad_step;
  $top->Unbusy;
  #my $elapsed = $timer;
  #undef $timer;
  #$elapsed = sprintf("Deletion took %.0f min, %.0f sec", $elapsed/60, $elapsed%60);
  #Echo($elapsed);
};

sub plot_marked_q {
  my $str = $plot_features{q_marked}; # }
  Echo('No data!'), return unless ($current);
  $top -> Busy(-recurse=>1,);
  update_hook();
  &set_key_params;
  $groups{$current}->plot_marked($str, $dmode, \%groups, \%marked, \%plot_features, $list, \@indicator);
  &refresh_properties;
  ($pointfinder{xvalue}, $pointfinder{yvalue}) = ("", "") unless ($last_plot eq 'q');
  $last_plot='q';
  $last_plot_params = [$current, 'marked', 'q', $str];
  $plotsel->raise('q') unless ($plotsel->raised() =~ /(Stack|Ind|PF)/);
  section_indicators();
  $pointfinder{space} -> configure(-text=>"The last plot was a marked plot");
  foreach (qw(x xpluck xfind y ypluck clear)) {
    $pointfinder{$_} -> configure(-state=>'disabled');
  };
  my $bad_step = 0;
  foreach my $k (keys %marked) {
    next unless $marked{$k};
    ++$bad_step if ($groups{$k}->{bkg_step} < 0);
  };
  Error("The edge step of one or more groups is negative!  You probably need to adjust the normalization parameters.")
    if $bad_step;
  $top->Unbusy;
};


sub keyboard_plot_marked {
  my $who = $top->focusCurrent;
  $multikey = "";
  Echo("Plot marked groups: specify plot space (e k r q)");
  $echo -> focus();
  $echo -> grab;
  $echo -> waitVariable(\$multikey);
  $echo -> grabRelease;
  $who -> focus;
  Echo("$multikey is not a plot space!"), return unless (lc($multikey) =~ /^[ekqr]$/);
 SWITCH: {
    &plot_marked_e, last SWITCH if (lc($multikey) eq 'e');
    &plot_marked_k, last SWITCH if (lc($multikey) eq 'k');
    &plot_marked_r, last SWITCH if (lc($multikey) eq 'r');
    &plot_marked_q, last SWITCH if (lc($multikey) eq 'q'); 	# ,
  };
};


sub set_key_params {
  Ifeffit::put_scalar('&plot_key_x',  $config{plot}{'key_x'});
  Ifeffit::put_scalar('&plot_key_y0', $config{plot}{'key_y'});
  Ifeffit::put_scalar('&plot_key_dy', $config{plot}{'key_dy'});
};


sub hide_show_plot_options {
  if ($plot_features{options_showing}) {
    $plotsel->packForget;
    $plot_features{options_showing} = 0;
    $po_left  -> configure(-text=>'^');
    $po_right -> configure(-text=>'^');
  } else {
    $plotsel->pack(-fill => 'x', -side => 'bottom', -anchor=>'s');
    $plot_features{options_showing} = 1;
    $po_left  -> configure(-text=>'v');
    $po_right -> configure(-text=>'v');
  };
};

sub detach_plot {
  #eval {Tk::Wm->release};
  $plot_menu->menu->entryconfigure(12, -state=>'disabled');
  #$top->update;
  #$detached_plot->deiconify;
  #$detached_plot->raise;
  #$b_frame -> pack(-in=>$detached_plot);
  $b_frame->packForget;
  $b_frame->wmRelease;
  $b_frame->raise;
  $b_frame->MainWindow::protocol('WM_DELETE_WINDOW', \&reattach_plot);
  $b_frame->MainWindow::title('Athena: plot buttons');
  $b_frame->MainWindow::iconimage($iconimage);
  $replace = $b_frame ->
    Button(-text=>'Replace',
	   -font=>$config{fonts}{smbold}, @button_list,
	   -command => \&reattach_plot)
      -> pack(-expand=>1, -fill=>'x', -padx=>4, -pady=>4);
  $b_frame->MainWindow::deiconify;
};

sub reattach_plot {
  Echonow("Replacing the plot buttons may take a few seconds...");
  $replace -> packForget;
  $b_frame -> wmCapture;
  $b_frame -> pack(-after=>$po, -anchor=>'n', -fill=>'x');
  $plot_menu->menu->entryconfigure(12, -state=>'normal');
  $top -> update;
  Echonow("Replaced plot buttons!");
};

## END OF PLOTTING SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  saving and restoring plotting styles


sub plst_save {
  my $name;
  my $label = "Name for this plot style: ";
  my $loop = 1;
  while ($loop) {
    my $ed = get_string($dmode, $label, \$name, \@rename_history);
    $ed -> waitWindow;	# the get_string dialog will be
                        # destroyed once the user hits ok,
                        # then we can move on...
    Echo("Plot style save aborted."), return unless defined($name);
    Echo("Plot style save aborted."), return if ($name =~ /^\s*$/);
    $label = "Name (other than \"default\") for this plot style: ", next if ($name eq 'default');
    if (exists $plot_styles{$name}) {
      my $dialog = $top -> Dialog(-bitmap         => 'questhead',
				  -text           => "A plot style named \"$name\" already exists.",
				  -title          => 'Athena: Question...',
				  -buttons        => ['Overwrite', 'Different name', 'Cancel'],
				  -default_button => 'Overwrite');
      my $response = $dialog->Show();
      Echo("Plot style save aborted."), return if $response eq 'Cancel';
      next if $response eq 'Different name';
    };
    $loop = 0;
    foreach my $k (keys %plot_features) {
      next unless ($k =~ /^[ekqr](_|ma|mi)/);
      $plot_styles{$name}{$k} = $plot_features{$k};
    };
  };
  my $file = $groups{"Default Parameters"} -> find('athena', 'plotstyles');
  tied(%plot_styles) -> WriteConfig($file);
  Echo("Saved plot style \"$name\"");
};

sub plst_post_menu {
  ## figure out where the user clicked
  my $w = shift;
  my $Ev = $w->XEvent;
  delete $w->{'shiftanchor'};
  my ($X, $Y) = ($Ev->X, $Ev->Y);

  my @restore_list;
  my @discard_list;
  foreach my $ps (keys %plot_styles) {
    ##next if ($ps eq "___plst___");
    push @restore_list, [ command => $ps, -command => [\&plst_restore, $ps]];
    next if ($ps eq 'default');
    push @discard_list, [ command => $ps, -command => [\&plst_discard, $ps]];
  };

  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[
		      [ command   => "Save plot style",
		       -command   => \&plst_save],
		      [ cascade   => "Restore named style",
		       -tearoff   => 0,
		       -menuitems => [@restore_list]],
		      [ cascade   => "Discard named style",
		       -tearoff   => 0,
		       -menuitems => [@discard_list]],
		      [ command   => "About plot styles",
		       -command   => sub{pod_display("ui::styles.pod")}]
		     ])
	-> Post($X, $Y);
  $w -> break;
};

sub plst_restore {
  foreach my $k (keys %plot_features) {
    next unless ($k =~ /^[ekqr](_|ma|mi)/);
    $plot_features{$k} = $plot_styles{$_[0]}{$k};
  };
  #$last_plot='e';
  #$last_plot_params = [$current, 'marked', 'e', $str];
  if ($current eq 'Default Parameters') {
    1; # do nothing, probably there are no records in the project
  } elsif (not exists($last_plot_params->[1])) {
    1; # do nothing, probably there are no records in the project
  } elsif ($last_plot_params->[1] eq 'group') {
    autoreplot($last_plot);
  } else {
  SWITCH: {
      &plot_marked_e, last SWITCH if (lc($last_plot) eq 'e');
      &plot_marked_k, last SWITCH if (lc($last_plot) eq 'k');
      &plot_marked_r, last SWITCH if (lc($last_plot) eq 'r');
      &plot_marked_q, last SWITCH if (lc($last_plot) eq 'q'); 	# ,
    };
  };

  Echo("Restored saved plot style \"$_[0]\"");
};

sub plst_discard {
  my $dialog = $top -> Dialog(-bitmap         => 'questhead',
			      -text           => "Are you sure you want to discard plot style \"$_[0]\"?",
			      -title          => 'Athena: Question...',
			      -buttons        => ['Discard', 'Cancel'],
			      -default_button => 'Discard');
  my $response = $dialog->Show();
  Echo("Not discarding \"$_[0]\""), return if $response eq 'Cancel';
  delete $plot_styles{$_[0]};
  tied(%plot_styles) -> WriteConfig($groups{"Default Parameters"} -> find('athena', 'plotstyles'));
  Echo("Discarded plot style \"$_[0]\"");
};

## END OF PLOT STYLES SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2010 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  writing project files


sub save_project {
  Echo('No data!'), return unless ($current);
  my $save = lc($_[0]);
  if ($save eq 'marked') {
    my $m = 0;
    map {$m += $_} values %marked;
    Error("Saving marked groups aborted.  There are no marked groups."), return 1 unless ($m);
  };
  my $file;
  my $curr = $current;
  my $how  = 2;
  if (($save ne 'all quick') or ($project_name =~ /^\s*$/)) {
    my $path = $current_data_dir || Cwd::cwd;
    my $init = 'athena.prj';
    if ($project_name !~ /^\s*$/) {
      my $suff;
      ($init, $path, $suff) = fileparse($project_name);
    };
    local $Tk::FBox::a;
    local $Tk::FBox::b;
    my $types = [['Athena project files', '.prj'],
		 ['All Files', '*'],];
    $file = $top -> getSaveFile(-defaultextension=>'.prj',
				-filetypes=>$types,
				#(not $is_windows) ?
				#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-initialfile=>$init,
				-title => "Athena: Save project");
    return unless $file;
    #my ($name, $pth, $suffix) = fileparse($file);
    #$current_data_dir = $pth;
    if ($save eq 'marked') {
      &push_mru($file, 1, 0);
    } else {
      &push_mru($file, 1, 1, 1);
    };
  } else {
    $file = $project_name;
  };
  ##open REC, '>'.$file or die $!;
  open REC, '>'.$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  $top -> Busy(-recurse=>1,);
  local $| = 1;
  print REC "# Athena project file -- Athena version $VERSION\n";
  print REC $groups{$current} -> project_header;
  close REC;
  my $save_groupreplot = $config{general}{groupreplot};
  $config{general}{groupreplot} = 'none';
  my @keys = &sorted_group_list;
  foreach (@keys) {
    next if ($_ eq "Default Parameters");
    next if (($save eq 'marked') and (not $marked{$_}));
    set_properties(0, $_, 1);
    save_record($file, $how++, 0, $save);
  };
  open REC, '>>'.$file or die $!;
  my $journal = $notes{journal} -> get(qw(1.0 end));
  my $eol = $/;
  my $colon = ":";
  my $end = "End";
  my $lv = ucfirst("local ");
  my @journal = split(/$eol/, $journal);
  print REC Data::Dumper->Dump([\@journal], [qw/*journal/]), "\n\n";
  print REC Data::Dumper->Dump([\%plot_features], [qw/*plot_features/]), "\n\n";
  my @indic = (0);
  foreach (1 .. $#indicator) {
    push @indic, ["", $indicator[$_]->[1], $indicator[$_]->[2]]
  };
  print REC Data::Dumper->Dump([\@indic], [qw/*indicator/]), "\n\n";
  print REC Data::Dumper->Dump([\%lcf_data], [qw/*lcf_data/]), "\n\n";
  $lv .= "Var" . "iables";
  print REC "\n1;\n\n# $lv$colon\n# truncate-lines$colon t\n# End$colon\n";
  close REC;
  if ($config{general}{compress_prj}) {
    Echo("Compressing $file");
    my $stash = File::Spec->catfile($stash_dir, basename($file));
    move($file, $stash);
    my $gz    = gzopen($stash, 'rb');
    my $gzout = gzopen($file, 'wb9');
    my $buffer;
    $gzout->gzwrite($buffer) while $gz->gzread($buffer) > 0 ;
    $gz->gzclose;
    $gzout->gzclose;
    unlink $stash;
  };
  set_properties(1, $curr, 1);
  $config{general}{groupreplot} = $save_groupreplot;
  project_state(1) unless ($save eq 'marked');
  ($save =~ /all/)    and Echo("Saved entire project to $file", 0);
  ($save eq 'marked') and Echo("Saved all marked groups to $file", 0);
  $top->Unbusy;
};

sub read_record {
  my ($plot, $file, $old_group, $ra, $rx, $ry, $rstddev, $ri0) = @_;
  my $gp = "";
  my @args = @$ra; my @x = @$rx; my @y = @$ry; my @stddev = @$rstddev; my @i0 = @$ri0;

  ## deal with backward compatibility issues in the parameters
  ##
  ## need to accommodate the change to (groupname != listentry) in
  ## 0.8.009 without breaking old project files.  search ahead in
  ## @args for the label string and use it, if found.  otherwise use
  ## the old group name as the argument to group_name
  ##
  ## there is a chance that a project file comes from a version of
  ## athena between when I introduced peak fitting and when I made the
  ## main window modal.  I need to check that values of "fit
  ## amplitude" and "set amplitude" (from peak fitting) are changed to
  ## "fit amp."  and "set amp."
  ##
  ## then in 0.8.028 I change "arctangent" to "atan" and so on.
  my $old_label = $old_group;
  my $is_frozen = 0;
  foreach (0 .. $#args) {
    next unless defined $args[$_]; # undef is a possible value in @args
    if ($args[$_] eq 'label') {
      $old_label = $args[$_+1];
      next;
    } elsif ($args[$_] =~ /(fit|set) amplitude(.*)/) {
      $args[$_] = $1 . " amp." . $2;
    } elsif ($args[$_] =~ /peak_step/) { # this is to accommodate a
      $args[$_] =~ s/step/function/;     # small change to peakfitting
    				         # for 0.8.018
    } elsif (lc($args[$_]) =~ /arctangent/) {
      $args[$_] = 'atan';
    } elsif (lc($args[$_]) =~ /error/) {
      $args[$_] = 'erf';
    } elsif (lc($args[$_]) =~ /gauss/) {
      $args[$_] = 'gauss';
    } elsif (lc($args[$_]) =~ /loren/) {
      $args[$_] = 'loren';
    } elsif ($args[$_] eq 'frozen') { # need to turn off frozen-ness until the
      $is_frozen = $args[$_+1];       # record is imported
      $args[$_+1] = 0;
    };
  };

  my ($group, $label) = group_name($old_label);
  $label =~ s{[\"\']}{}g;
  ++$line_count;
  $groups{$group} = Ifeffit::Group -> new(file=>$file, group=>$group, label=>$label);
  $groups{$group} -> make(@args);
  $groups{$group} -> make(line=>$line_count, old_group=>$old_group);
  $groups{$group} -> make(is_rec=>1, is_raw=>0, update_bkg=>1, is_proj=>1);
  $groups{$group} -> make(i0 => "$group.i0") if (@i0);
  $groups{$group} -> put_titles;
  my ($x, $y, $z) = (0, 0, 0);
 SWITCH: {
    ($x,$y)    = ('.energy', '.det'),            last SWITCH if $groups{$group}->{not_data};
    ($x,$y)    = ('.energy', '.xmu'),            last SWITCH if $groups{$group}->{is_xmu};
    ($x,$y)    = ('.k',      '.chi'),            last SWITCH if $groups{$group}->{is_chi};
    ($x,$y,$z) = ('.r', '.chir_re', '.chir_im'), last SWITCH if $groups{$group}->{is_rsp};
    ($x,$y,$z) = ('.q', '.chiq_re', '.chiq_im'), last SWITCH if $groups{$group}->{is_qsp};
  };
  Ifeffit::put_array($group.$x, \@x);
  Ifeffit::put_array($group.$y, \@y);
  Ifeffit::put_array("$group.stddev", \@stddev) if (@stddev);
  Ifeffit::put_array("$group.i0",     \@i0)     if (@i0);
  ##($z) and Ifeffit::put_array($group.$z, \@z);

  ## fill_skinny unsets this parameter and it needs to be dealt with
  ## after the entire project is read
  my $save_stan = $groups{$group}->{bkg_stan};
  fill_skinny($list, $group, 1);
  $groups{$group}->make(bkg_stan=>$save_stan);
  if ($is_frozen) { # turn frozen-ness back on
    $groups{$group}->freeze;
    freeze_chores($group);
  };
  ($gp) or ($gp = $group);
  return $group unless $plot;
				# what about reading r or q records?
 SWITCH: {
    ($groups{$gp}->{is_xmu}) and do {
      $groups{$gp} -> plotE('emz',$dmode,\%plot_features, \@indicator);
      $last_plot = 'e';
      $last_plot_params = [$gp, 'group', 'e', 'emz'];
      last SWITCH;
    };
    ($groups{$gp}->{is_chi}) and do {
      #my $str = sprintf('k%1d', $groups{$gp}->{fft_kw});
      my $str = sprintf('k%1d', $plot_features{kw});
      $groups{$gp} -> plotk($str,$dmode,\%plot_features, \@indicator);
      $last_plot = 'k';
      $last_plot_params = [$gp, 'group', 'k', $str];
      last SWITCH;
    };
  };
  return $group;
};


## the call to save_record takes three arguments:
##  1st: filename or nil to prompt for filename
##  2nd: 0=open file to overwite, 1=open file to append
##  3rd: 0=save record as record type, 1=force saving as chi(k)

## save a record as a Data::Dumper file.  This contains four lvalues,
## 1) the group name from this session, 2) an array of parameters, 3)
## an x-array, 4) a y-array.  The x- and y-arrays are appropriate to
## the initial state of the data (i.e. the intial state of raw data is
## energy/xmu and the initial state of merged chi(k) data is k/chi).
sub save_record {
  Echo('No data!'), return unless ($current);
  Echo("Saving records is unsupported for R- and q-space data", 0), return
    if (($groups{$current}->{is_rsp}) or ($groups{$current}->{is_qsp}));
  Echonow("Saving record for group \"$groups{$current}->{label}\"", 0);
  my ($file, $how, $force_chik, $save) = @_;
  #my $how = ((defined $_[1]) and $_[1]) ? $_[1] : 0;
  #if (defined $_[0] and  $_[0]) {
  #  $file = $_[0]; # File::Spec->catfile($current_data_dir, $_[0].".rec");
  #} else {
  unless ($file) {
    local $Tk::FBox::a;
    local $Tk::FBox::b;
    my $path = $current_data_dir || Cwd::cwd;
    my $fname = ($force_chik) ? $current . "_chik.rec" : "$current.rec";
    my $types = [['Athena record files', '.rec'],
		 ['All Files', '*'],];
    $file = $top -> getSaveFile(-defaultextension=>'rec',
				-filetypes=>$types,
				#(not $is_windows) ?
				#  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-initialfile=>$fname,
				-title => "Athena: Save record");
    Echonow("Saving record for group \"$groups{$current}->{label}\" ... canceled", 0), return
      unless $file;
    my ($name, $pth, $suffix) = fileparse($file);
    $current_data_dir = $pth;
    ##&push_mru($file, 1);
  };
  refresh_titles($groups{$current}); # make sure titles are up-to-date
  my @args = ();
  foreach (sort keys(%{$groups{$current}})) {
    next if ($_ =~ /\b([ex]col|check(button)?|group|id|rect|text)\b/);
    next if ($_ eq 'made_pixel');
    next if ($_ =~ /^update/);
    next if ($_ eq "project_marked");
    ##next if ($_ =~ /^title/);
    if (($save eq 'marked') and ($_ eq 'reference') and ($groups{$current}->{reference})) {
      my $ref = $groups{$current}->{reference};
      next unless $marked{$ref};
    };
    push @args, $_, $groups{$current}->{$_};
  };
  push @args, "project_marked", $marked{$current};
  ## need to update from titles palette
  ## my @titles = @{$groups{$current}->{titles}};
  my (@x, @y, @z, @stddev, @i0);
 SWITCH: {
    ($force_chik) and do {
      $groups{$current}->dispatch_bkg($dmode) if $groups{$current}->{update_bkg};
      @x = Ifeffit::get_array($current.".k");
      @y = Ifeffit::get_array($current.".chi");
      ## need to flag this as a chi record -- appending new values to
      ## the end of @args is cheesy, but it works
      push @args, qw(is_chi 1 is_bkg 0 is_xmu 0 is_nor 0 is_merge 0);
      last SWITCH;
    };
    ($groups{$current}->{not_data}) and do {
      @x = Ifeffit::get_array($current.".energy");
      ## @x = map {$_ + $groups{$current}->{bkg_eshift}} @x;
      @y = Ifeffit::get_array($current.".det");
      last SWITCH;
    };
    ($groups{$current}->{is_xmu}) and do {
      @x = Ifeffit::get_array($current.".energy");
      ## @x = map {$_ + $groups{$current}->{bkg_eshift}} @x;
      @y = Ifeffit::get_array($current.".xmu");
      @i0 = Ifeffit::get_array($groups{$current}->{i0}) if ($groups{$current}->{i0});
      last SWITCH;
    };
    ($groups{$current}->{is_chi}) and do {
      @x = Ifeffit::get_array($current.".k");
      @y = Ifeffit::get_array($current.".chi");
      last SWITCH;
    };
    ($groups{$current}->{is_rsp}) and do {
      @x = Ifeffit::get_array($current.".r");
      @y = Ifeffit::get_array($current.".chir_re");
      @z = Ifeffit::get_array($current.".chir_im");
      last SWITCH;
    };
    ($groups{$current}->{is_qsp}) and do {
      @x = Ifeffit::get_array($current.".q");
      @y = Ifeffit::get_array($current.".chiq_re");
      @z = Ifeffit::get_array($current.".chiq_im");
      last SWITCH;
    };
  };
  ## what about chi(k) records with stddev???
  if ((not $force_chik) and $groups{$current}->{is_merge}) {
    @stddev = Ifeffit::get_array($current.".stddev");
  };
  my $open = ($how > 1) ? '>>' : '>';
  my $arg = (($how == 0) or ($how == 2)) ? 1 : 0;
  open REC, $open.$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  ($how) or print REC "# Athena record file -- Athena version $VERSION\n";
  ($how) or print REC $groups{$current} -> project_header();
  print REC
    Data::Dumper->Dump([$current], [qw/old_group/]), "\n",
    Data::Dumper->Dump([\@args],   [qw/*args/]),     "\n",
    Data::Dumper->Dump([\@x],      [qw/*x/]),        "\n",
    Data::Dumper->Dump([\@y],      [qw/*y/]),        "\n";
  print REC Data::Dumper->Dump([\@stddev],[qw/*stddev/]), "\n" if @stddev;
  print REC Data::Dumper->Dump([\@i0],    [qw/*i0/]),     "\n" if $groups{$current}->{i0};
  print REC "[record]   # create object and set arrays in ifeffit\n\n";
  unless ($how) {

    my $colon = ":";
    my $end = "End";
    my $lv = ucfirst("local ");
    $lv .= "Var" . "iables";
    print REC "\n1;\n\n# $lv$colon\n# truncate-lines$colon t\n# End$colon\n";
  };
  close REC;
  Echonow("Wrote record to $file", 0);
};


sub close_project {
  reset_window($which_showing, $fat_showing, 0) unless ($fat_showing eq 'normal');
  delete_many($list, $dmode, 0);
  project_state(1);
  $plot_features{project} = q{};
};

sub clear_project_name {
  $plot_features{project} = q{};
  $project_name = q{};
  project_state(0);
};

## state=0 -> project needs to be saved  state=1 -> project has been saved
sub project_state {
  return unless $current;
  ##$_[0] || print join(" ", caller), $/;
  $project_saved = $_[0];
  $lab -> configure(-text   => ($_[0]) ? "" : "modified",);
  return if ($current eq "Default Parameters");
  autoreplot() if $config{general}{autoreplot};
  section_indicators();
};


sub examine_project {
  my ($prjfile, $r_hash, $r_cancel, $r_project_no_prompt) = @_;
  my @athena_index  = ();
  my @athena_groups = ();
  my $titles;

  my $prj = $top->Toplevel(-class=>'horae');
  $prj -> withdraw;
  $prj -> title("Athena: import from project file");
  $prj -> protocol(WM_DELETE_WINDOW => sub{$$r_cancel = 1; $prj->destroy; return});
  $prj -> packPropagate(1);
  $prj -> bind('<Control-q>' => sub{$$r_cancel = 1; $prj->destroy; return});
  $prj -> bind('<Control-d>' => sub{$$r_cancel = 1; $prj->destroy; return});

  $prj -> Label(-text       => $prjfile,
		-foreground => $config{colors}{activehighlightcolor},
		-font       => $config{fonts}{bold},
		-borderwidth=> 2,
		-relief     => 'ridge',
	       )
    -> pack(-side=>'top', -fill=>'x', -padx=>0, -pady=>0);

  my $labframe = $prj -> LabFrame(-label=>'Project groups',
				  -labelside=>'acrosstop',
				  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left', -expand=>1, -fill=>'both', -anchor=>'w');

  my $hlist;
  $hlist = $labframe -> Scrolled('HList',
				 -scrollbars	   => 'osoe',
				 -columns	   => 1,
				 -header	   => 0,
				 -selectmode	   => 'extended',
				 -width		   => 25,
				 -height	   => 30,
				 -background	   => $config{colors}{hlist},
				 #-highlightcolor => $config{colors}{hlist},
				 -selectbackground => $config{colors}{current},
				 -browsecmd	   =>
				 sub {
				   ## only plot if this selection is
				   ## also the anchor
				   return if $hlist->info('anchor') ne $_[0];
				   project_plot($hlist, $titles, $prjfile);
				 },
				)
    -> pack(-expand=>1, -fill=>'both');
  $hlist->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					     ($is_windows) ? () : (-width=>8));
  $hlist->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					     ($is_windows) ? () : (-width=>8));
  BindMouseWheel($hlist);

  my $fr = $prj -> Frame()
    -> pack(-side=>'right', -expand=>1, -fill=>'both', -anchor=>'n');
  $labframe = $fr -> LabFrame(-label=>'Journal',
			      -labelside=>'acrosstop',
			      -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'both', -padx=>0, -pady=>0);
  my $journal =  $labframe -> Scrolled('ROText',
				       -scrollbars => 'osoe',
				       -wrap       => 'none',
				       -height     => 12,)
    -> pack(-expand=>1, -fill=>'both');
  $journal->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					       ($is_windows) ? () : (-width=>8));
  $journal->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					       ($is_windows) ? () : (-width=>8));
  $journal -> tagConfigure("text", -font=>$config{fonts}{fixedsm});
  BindMouseWheel($journal);
  disable_mouse3($journal->Subwidget("rotext"));

  ## selection buttons
  my $button_frame = $fr -> LabFrame(-label=>'Select groups',
				     -labelside=>'acrosstop',
				     -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -expand=>1, -fill=>'x', -padx=>0, -pady=>0);
  $button_frame -> Button(-text	       => "All",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     => sub{ $hlist->selectionSet(@athena_index[0,-1]) },
			 )
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);
  $button_frame -> Button(-text	       => "None",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     => sub{{$hlist->selectionClear();
					       $hlist->anchorClear();} },
			 )
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);
  $button_frame -> Button(-text	       => "Invert",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     =>
			  sub{
			    foreach my $i (@athena_index) {
			      ($hlist->selectionIncludes($i)) ?
				$hlist->selectionClear($i) :
				  $hlist->selectionSet($i);
			    };
			  },
			 )
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);

  $labframe = $fr -> LabFrame(-label	  => 'Selected group titles',
			      -labelside  => 'acrosstop',
			      -foreground => $config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -expand=>1, -fill=>'both', -padx=>0, -pady=>0);
  $titles =  $labframe -> Scrolled('ROText',
				   -scrollbars => 'osoe',
				   -wrap       => 'none',
				   -height     => 12,)
    -> pack(-expand=>1, -fill=>'both');
  $titles -> Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
						($is_windows) ? () : (-width=>8));
  $titles -> Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
						($is_windows) ? () : (-width=>8));
  $titles -> tagConfigure("text",    -font=>$config{fonts}{fixedsm});
  $titles -> tagConfigure("explain", -font=>$config{fonts}{fixedsm}, -foreground=>$config{colors}{button});
  BindMouseWheel($titles);
  disable_mouse3($titles->Subwidget("rotext"));


  ## ok/cancel buttons
  $button_frame = $fr -> Frame()
    -> pack(-side=>'bottom', -fill=>'x', -padx=>0, -pady=>0);
  $button_frame -> Button(-text	       => "Import",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     =>
			  sub {
			    my $n_selected = 0;
			    ## import bkg removal standards as well
			    foreach my $i (@athena_index) {
			      next if not $hlist->selectionIncludes($i);
			      my %args = project_get_array($prjfile, $i, "args");
			      next if ($args{bkg_stan} eq 'None');
			      my $j = 0;
			      foreach my $og (@athena_groups) {
				if ($og eq $args{bkg_stan}) {
				  $hlist->selectionSet($athena_index[$j]);
				  last;
				};
				++$j;
			      };
			    };
			    foreach my $i (@athena_index) {
			      ++$n_selected if $hlist->selectionIncludes($i);
			    };
			    $hlist->selectionSet(@athena_index[0,-1]) if not $n_selected;
			    if (($n_selected == 0) or ($n_selected == $#athena_index+1)) {
			      $$r_project_no_prompt = 1;
			    };
			    my $c = 0;
			    foreach my $i (@athena_index) {
			      $$r_hash{$athena_groups[$c]} = ($hlist->selectionIncludes($i)) ? 1 : 0;
			      ++$c;
			    };
			    $$r_cancel = 0;
			    $prj->destroy;
			    return(());
			  },
			 )
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>4, -pady=>4)
      -> focus;
  $button_frame -> Button(-text	       => "Quick help",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     => sub{project_quick_help($titles)},
		)
    -> pack(-side=>'left', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);
  $button_frame -> Button(-text	       => "Cancel",
			  @button_list,
			  -width       => 8,
			  -borderwidth => 1,
			  -command     => sub{$$r_cancel = 1; $prj->destroy; return(())},
			 )
    -> pack(-side=>'right', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);


  my $athena_fh = gzopen($prjfile, "rb") or die "could not open $prjfile as an Athena project\n";

  my $nline = 0;
  my $line = q{};
  ##while (<ORIG>) {
  my $cpt = new Safe;
  my $bytesread;
 PRJ: while (($bytesread = $athena_fh->gzreadline($line)) > 0) {
    my $error = $athena_fh->gzerror;
    ++$nline;
    if ($line =~ /^\@journal/) {
      @ {$cpt->varglob('journal')} = $cpt->reval( $line );
      my @journal = @ {$cpt->varglob('journal')};
      map { $journal -> insert('end', $_."\n", 'text') } @journal;
    };
    ##print $bytesread, " ", $error, $/;
    if ( (($bytesread < 0) or $error) and ($gzerrno != Z_STREAM_END) ) {
      pop @athena_groups;
      pop @athena_index;
      project_error($titles, $error);
      Error("An error was found while reading \"$prjfile\".");
      last PRJ;
    };
    next unless ($line =~ /^\$old_group/);
    push @athena_index, $nline;
    $ {$cpt->varglob('old_group')} = $cpt->reval($line);
    my $old_group = $ {$cpt->varglob('old_group')};
    push @athena_groups, $old_group;
    $$r_hash{$old_group} = 0;
  };
  $athena_fh->gzclose();
  undef $cpt;

  foreach my $i (@athena_index) {
    my %args = project_get_array($prjfile, $i, "args");
    $args{label} =~ s{[\"\']}{}g;
    $hlist -> add($i, -data=>$i);
    $hlist -> itemCreate($i, 0, -text=>$args{label});
  };

  if ($$r_project_no_prompt) {
    $hlist->selectionSet(@athena_index[0,-1]);
    my $c = 0;
    foreach my $i (@athena_index) {
      $$r_hash{$athena_groups[$c]} = ($hlist->selectionIncludes($i)) ? 1 : 0;
      ++$c;
    };
    $$r_cancel = 0;
    $prj->destroy;
    return 0;
  } else {
    $prj->deiconify;
    $prj->raise;
  };
  return $prj;

};


sub project_error {
  my ($titles, $error) = @_;
  $titles->delete(qw(1.0 end));
  $titles->insert('end', "  !!! WARNING !!!\n", 'explain');
  my $message = "
An error has been encountered reading this project file.  It is
likely that the file has been corrupted in some way.  All data
after the point of failure has been excluded from the groups list.

The error returned by zlib is:
  $error
";
  $titles->insert('end', $message, 'explain');
};


sub project_get_array {
  my ($prjfile, $index, $which) = @_;
  my $cpt = new Safe;
  my @array;
  my $prj = gzopen($prjfile, "rb") or die "could not open $prjfile as an Athena project\n";
  ##open A, $prjfile;
  my $count = 0;
  my $found = 0;
  my $re = '@' . $which;
  my $line = q{};
  ##foreach my $line (<A>) {
  while ($prj->gzreadline($line) > 0) {
    ++$count;
    $found = 1 if ($count == $index);
    next unless $found;
    last if ($line =~ /^\[record\]/);
    if ($line =~ /^$re/) {
      @ {$cpt->varglob('array')} = $cpt->reval( $line );
      @array = @ {$cpt->varglob('array')};
      last;
    };
  };
  $prj->gzclose();
  ##close A;
  return @array;
};

sub project_plot {
  my ($hlist, $titles, $prjfile) = @_;
  $top -> Busy;
  my $n = $hlist->info('anchor');
  my $i = $hlist->info('data', $n);
  my ($xlabel, $ylabel) = ("Energy (eV)", "x\\gm(E)");

  ## get the args hash
  my %args = project_get_array($prjfile, $i, "args");
  if ($args{is_chi}) {
    ($xlabel, $ylabel) = ("wavenumber (\\A\\u-1\\d)", "\\gx(k)*k\\u2\\d" );
  } elsif ($args{not_data}) {
    ($xlabel, $ylabel) = ("Energy (eV)",              "data"             );
  } elsif ($args{is_bkg}) {
    ($xlabel, $ylabel) = ("Energy (eV)",              "background(E)"    );
  } elsif ($args{is_pixel}) {
    ($xlabel, $ylabel) = ("pixel",                    "x\\gm(E)"         );
  };

  ## fill titles
  $titles->configure(-foreground=>$config{colors}{foreground});
  $titles->delete(qw(1.0 end));
  foreach my $t (@{ $args{titles} }) {
    $titles->insert('end', $t."\n", 'text');
  };

  ## get the x- and y-axis arrays
  my @x = project_get_array($prjfile, $i, "x");
  @x = map {$_ + $args{bkg_eshift}} @x if not $args{is_chi};
  my @y = project_get_array($prjfile, $i, "y");
  Ifeffit::put_array("p___rj.x", \@x);
  Ifeffit::put_array("p___rj.y", \@y);
  my $plot = ($args{is_chi})	# plot k^2 weighted chi(k)
    ? "newplot(p___rj.x, \"p___rj.y*p___rj.x**2\","
     : "newplot(p___rj.x, p___rj.y,";
  $plot .= "        title=\"$args{label}\", color=blue,";
  $plot .= "        xlabel=\"$xlabel\", ylabel=\"$ylabel\")\n";

  Echo("Plotting group from project \"$args{label}\"");
  $groups{"Default Parameters"}->dispose($plot, $dmode);

  Echo("Plotting groups from project \"$args{label}\" ... done!");
  $top -> Unbusy;
}

sub project_quick_help {
  my ($titles) = @_;
  my @hints = ("Click on a group to select and plot.",
	       "Control-click to add a group to the selection.",
	       "Shift-click or click-drag to select multiple groups.",
	       "All groups will be imported if none are selected.",);

  $titles->delete(qw(1.0 end));
  $titles->insert('end', "\n", 'explain');
  foreach my $h (@hints) {
    $titles->insert('end', $h."\n\n", 'explain');
  };
};

sub section_indicators {
  return unless $current;
  return unless (exists $groups{$current});
  my ($blue, $cyan, $grey) = ($config{colors}{activehighlightcolor},
			      $config{colors}{requiresupdate},
			      $config{colors}{disabledforeground});
  #($blue, $cyan) = ($config{colors}{frozen}, $config{colors}{frozenrequiresupdate}) if $groups{$current}->{frozen};

 SWITCH:{
    ($groups{$current}->{is_xanes}) and do {
      $header{bkg} -> configure(-foreground=>($groups{$current}->{update_bkg}) ? $cyan : $blue);
      $header{bkg_secondary} -> configure(-foreground=>($groups{$current}->{update_bkg}) ? $cyan : $blue);
      $header{fft} -> configure(-foreground=>$grey);
      $header{bft} -> configure(-foreground=>$grey);
      last SWITCH;
    };
    ($groups{$current}->{is_xmu}) and do {
      $header{bkg} -> configure(-foreground=>($groups{$current}->{update_bkg}) ? $cyan : $blue);
      $header{bkg_secondary} -> configure(-foreground=>($groups{$current}->{update_bkg}) ? $cyan : $blue);
      $header{fft} -> configure(-foreground=>($groups{$current}->{update_fft}) ? $cyan : $blue);
      $header{bft} -> configure(-foreground=>($groups{$current}->{update_bft}) ? $cyan : $blue);
      last SWITCH;
    };
    ($groups{$current}->{is_chi}) and do {
      $header{bkg} -> configure(-foreground=>$grey);
      $header{bkg_secondary} -> configure(-foreground=>$grey);
      $header{fft} -> configure(-foreground=>($groups{$current}->{update_fft}) ? $cyan : $blue);
      $header{bft} -> configure(-foreground=>($groups{$current}->{update_bft}) ? $cyan : $blue);
      last SWITCH;
    };
    ($groups{$current}->{is_rsp}) and do {
      $header{bkg} -> configure(-foreground=>$grey);
      $header{bkg_secondary} -> configure(-foreground=>$grey);
      $header{fft} -> configure(-foreground=>$grey);
      $header{bft} -> configure(-foreground=>($groups{$current}->{update_bft}) ? $cyan : $blue);
      last SWITCH;
    };
    ($groups{$current}->{is_qsp}) and do {
      $header{bkg} -> configure(-foreground=>$grey);
      $header{bkg_secondary} -> configure(-foreground=>$grey);
      $header{fft} -> configure(-foreground=>$grey);
      $header{bft} -> configure(-foreground=>$grey);
      last SWITCH;
    };
    ($groups{$current}->{not_data}) and do {
      $header{bkg} -> configure(-foreground=>$grey);
      $header{bkg_secondary} -> configure(-foreground=>$grey);
      $header{fft} -> configure(-foreground=>$grey);
      $header{bft} -> configure(-foreground=>$grey);
      last SWITCH;
    };
  };

};

## END OF PROJECT FILE SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  report generation.

sub report_csv {
  my $how = $_[0];
  if ($how eq 'marked') {
    my $m = 0;
    map {$m += $_} values %marked;
    Error("Report aborted.  There are no marked groups."), return 1 unless ($m);
  };

  my $types = [['Comma separated value files', '.csv'], ['All Files', '*'],];
  my $path = $current_data_dir || Cwd::cwd;
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>"athena.csv",
				 -title => "Athena: Write report");
  return unless $file;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  #&push_mru($file, 0);
  Echo("Generating CSV report to \"$file\" ...");

  open CSV, ">".$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  print CSV "# Athena CSV report -- Athena version $VERSION\n";
  print CSV $groups{$current} -> project_header;
  print CSV ",,,Background Removal Parameters,,,,,,,,,,,,,,,,,Forward Fourier transform parameters,,,,,,,,Backward Fourier transform parameters,,,,Plotting parameters,\n";
  do {
    no warnings; # avoid warning about commas after File Clamp2 r-range
    print CSV join(',', qw(Group File, E0 Rbkg Standard Algorithm Element k-weight),
		   'E0 shift', 'Edge Step', 'Fixed Step', 'Functional normalization', 'Pre-edge range',
		   'Normalization range', 'Spline range', 'Nknots',
		   qw(Clamp1 Clamp2, arb-k-weight dk window k-range),
		   'Do PC', 'PC element', 'PC edge,',
		   qw(dr window r-range,),
		   'Scaling factor', 'y-offset'), "\n\n";
  };

  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    (my $str = $groups{$k}->{label}) =~ s/,/ /g;
    print CSV $str;
    ($str = $groups{$k}->{file}) =~ s/,/ /g;
    print CSV ",", $str,",";
    foreach my $p (qw(bkg_e0 bkg_rbkg bkg_stan)){
      print CSV ",", $groups{$k}->{$p};
    };
    printf CSV ($groups{$k}->{bkg_cl}) ? ",Cromer-Liberman" : ",Autobk";
    foreach my $p (qw(bkg_z bkg_kw bkg_eshift bkg_step)) {
       print CSV ",", $groups{$k}->{$p};
    };
    printf CSV ($groups{$k}->{bkg_fixstep}) ? ",yes" : ",no";
    printf CSV ($groups{$k}->{bkg_fnorm}) ? ",yes" : ",no";
    printf CSV ",[%s : %s]", $groups{$k}->{bkg_pre1}, $groups{$k}->{bkg_pre2};
    printf CSV ",[%s : %s]", $groups{$k}->{bkg_nor1}, $groups{$k}->{bkg_nor2};
    printf CSV ",[%s : %s]", $groups{$k}->{bkg_spl1}, $groups{$k}->{bkg_spl2};
    my $deltak = $groups{$current}->{bkg_spl2} - $groups{$current}->{bkg_spl1};
    print CSV ",",int( 2 * $deltak * $groups{$k}->{bkg_rbkg} / PI ) + 1;
    foreach my $p (qw(bkg_clamp1 bkg_clamp2)) {
      print CSV ",", $groups{$k}->{$p};
    };
    print CSV ",";
    ## begin fft params
    foreach my $p (qw(fft_arbkw fft_dk fft_win)) {
      print CSV ",", $groups{$k}->{$p};
    };
    printf CSV ",[%s - %s]", $groups{$k}->{fft_kmin}, $groups{$k}->{fft_kmax};
    print CSV ", ", ($groups{$k}->{fft_pc} eq 'on') ? 'yes' : 'no';
    foreach my $p (qw(bkg_z fft_edge)) {
      print CSV ",", $groups{$k}->{$p};
    };
    print CSV ",";
    ## begin bft params
    foreach my $p (qw(bft_dr bft_win)) {
      print CSV ",", $groups{$k}->{$p};
    };
    printf CSV ",[%s-%s]", $groups{$k}->{bft_rmin}, $groups{$k}->{bft_rmax};
    print CSV ",";
    ## begin plot params
    foreach my $p (qw(plot_scale plot_yoffset)) {
      print CSV ",", $groups{$k}->{$p};
    };
    print CSV "\n";
  };
  close CSV;
  Echo("Generating CSV report to \"$file\" ... done!");
};



sub report_excel {
  my $how = $_[0];
  if ($how eq 'marked') {
    my $m = 0;
    map {$m += $_} values %marked;
    Error("Report aborted.  There are no marked groups."), return 1 unless ($m);
  };

  my $types = [['Excel files', '.xls'], ['All Files', '*'],];
  my $path = $current_data_dir || Cwd::cwd;
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>"athena.xls",
				 -title => "Athena: Write report");
  return unless $file;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  #&push_mru($file, 0);
  Echo("Generating Excel report to \"$file\" ...");

  ## new workbook with one sheet
  my $workbook = Spreadsheet::WriteExcel -> new($file) or do {
    Error("You cannot write a spreadsheet to \"$file\".");
    return;
  };
  $workbook -> set_codepage(2) if (lc($^O) eq 'darwin');
  my $worksheet = $workbook -> addworksheet('Athena parameters');

  ## several formats for different kinds of cells
  my $topheader = $workbook->addformat(bold=>1, color=>'black', bg_color=>'gray',
				      align=>'left');
  my $header  = $workbook->addformat(bold=>1, bg_color=>'grey', align=>'center');
  my $number  = $workbook->addformat(align=>'center', num_format=>'0.000');
  #$number    -> set_num_format('0.000');
  my $integer = $workbook->addformat(align=>'center');
  my $string  = $workbook->addformat(align=>'center');
  my $fname   = $workbook->addformat(italic=>1);
  my $sep     = $workbook->addformat(align=>'center');
  #$sep       -> set_bg_color(22);

  my $col = 0;
  my $row = 1;

  my $comment = "# Athena Excel report -- Athena version $VERSION\n";
  $comment   .= $groups{$current} -> project_header;
  chomp $comment;
  $comment   .= " (Spreadsheet::WriteExcel version $Spreadsheet::WriteExcel::VERSION)";
  $comment   =~ s/\# //g;
  foreach (split(/\n/, $comment)) {
    $worksheet -> merge_range($row, 0, $row, 33, $_, $topheader);
    $row++;
  };
  $row++;

  ## set up the top-most header line
  $worksheet -> write_blank($row, 0);
  $worksheet -> write_blank($row, 1);
  $worksheet -> merge_range($row, 3,$row,18, 'Background removal parameters', $topheader);
  $worksheet -> merge_range($row,20,$row,26, 'Forward transform parameters',  $topheader);
  $worksheet -> merge_range($row,28,$row,30, 'Backward transform parameters', $topheader);
  $worksheet -> merge_range($row,32,$row,33, 'Plotting parameters',           $topheader);
  $row++;

  ## write the column headers
  foreach (qw(Group File)) {
    $worksheet -> write($row, $col++, $_, $header);
  };
  $worksheet -> write_blank($row-1, $col);
  $worksheet -> write_blank($row, $col++);
  ## background parameters
  foreach (qw(E0 Rbkg Standard Algorithm Element k-weight), 'E0 shift',
	   'Edge Step', 'Fixed Step', 'Functional norm.', 'Pre-edge range',
	   'Normalization range', 'Spline range', 'Nknots',
	   qw(Clamp1 Clamp2)) {
    $worksheet -> write($row, $col++, $_, $header);
  };
  $worksheet -> write_blank($row-1, $col); # lines like this fill gaps
  $worksheet -> write_blank($row, $col++);
  ## fft parameters
  foreach ('arbitrary k-weight', qw(dk window k-range), 'Do PC', 'PC element', 'PC edge') {
    $worksheet -> write($row, $col++, $_, $header);
  };
  $worksheet -> write_blank($row-1, $col);
  $worksheet -> write_blank($row, $col++);
  ## bft parameters
  foreach (qw(dR window R-range)) {
    $worksheet -> write($row, $col++, $_, $header);
  };
  $worksheet -> write_blank($row-1, $col);
  $worksheet -> write_blank($row, $col++);
  ## plot parameters
  foreach ('Scaling factor', 'y-offset') {
    $worksheet -> write($row, $col++, $_, $header);
  };
  $row++;

  ## set all the column widths to sensible values (very fiddly!)
  $worksheet->set_column(0, 0, 15); # group
  $worksheet->set_column(1, 1, 10); # file
  $worksheet->set_column(2, 2,  2); # spacer
  foreach (3  .. 12) { $worksheet->set_column($_, $_, 12) }; # bkg params
  foreach (13 .. 15) { $worksheet->set_column($_, $_, 20) }; # ranges
  $worksheet->set_column(16, 16, 7); # nknots
  foreach (17 .. 18) { $worksheet->set_column($_, $_, 12) }; # clamps
  $worksheet->set_column(19, 19, 2); # spacer
  foreach (21 .. 21) { $worksheet->set_column($_, $_, 12) }; # fft params
  $worksheet->set_column(22, 22, 16); # k window
  foreach (23 .. 25) { $worksheet->set_column($_, $_, 12) }; # k-range
  $worksheet->set_column(27, 27,  2); # spacer
  $worksheet->set_column(28, 28, 12); # dr
  $worksheet->set_column(29, 29, 16); # r-window
  $worksheet->set_column(30, 30, 12); # r-range
  $worksheet->set_column(31, 31,  2); # spacer
  foreach (32 .. 33) { $worksheet->set_column($_, $_, 18) }; # plotting params

  ## write out the parameters for each (marked) group, taking care to
  ## set formats appropriately
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    $col = 0;
    $worksheet -> write($row, $col++,  $groups{$k}->{label}, $string);
    $worksheet -> write($row, $col++,  $groups{$k}->{file}, $fname);
    $worksheet -> write_blank($row, $col++, $sep);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_e0}, $number);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_rbkg}, $number);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_stan}, $number);
    $worksheet -> write($row, $col++, ($groups{$k}->{bkg_cl}) ? "Cromer-Liberman" : "Autobk",
			$string);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_z}, $string);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_kw}, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_eshift}, $number);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_step}, $number);
    $worksheet -> write($row, $col++, ($groups{$k}->{bkg_fixstep}) ? "yes" : "no", $string);
    $worksheet -> write($row, $col++, ($groups{$k}->{bkg_fnorm}) ? "yes" : "no", $string);
    $worksheet -> write($row, $col++,
			sprintf("[%.3f : %.3f]", $groups{$k}->{bkg_pre1}, $groups{$k}->{bkg_pre2}),
			$string);
    $worksheet -> write($row, $col++,
			sprintf("[%.3f : %.3f]", $groups{$k}->{bkg_nor1}, $groups{$k}->{bkg_nor2}),
			$string);
    $worksheet -> write($row, $col++,
			sprintf("[%.3f : %.3f]", $groups{$k}->{bkg_spl1}, $groups{$k}->{bkg_spl2}),
			$string);
    my $deltak = $groups{$current}->{bkg_spl2} - $groups{$current}->{bkg_spl1};
    $worksheet -> write($row, $col++,  int( 2 * $deltak * $groups{$current}->{bkg_rbkg} / PI ) + 1, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_clamp1}, $string);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_clamp2}, $string);
    $worksheet -> write_blank($row, $col++, $sep);
    $worksheet -> write($row, $col++,  $groups{$k}->{fft_arbkw}, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{fft_dk}, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{fft_win}, $string);
    $worksheet -> write($row, $col++,
			sprintf("[%s : %s]", $groups{$k}->{fft_kmin}, $groups{$k}->{fft_kmax}),
			$string);
    $worksheet -> write($row, $col++,  $groups{$k}->{fft_pc}, $string);
    $worksheet -> write($row, $col++,  $groups{$k}->{bkg_z}, $string);
    $worksheet -> write($row, $col++,  $groups{$k}->{fft_edge}, $string);
    $worksheet -> write_blank($row, $col++, $sep);
    $worksheet -> write($row, $col++,  $groups{$k}->{bft_dr}, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{bft_win}, $string);
    $worksheet -> write($row, $col++,
			sprintf("[%s : %s]", $groups{$k}->{bft_rmin}, $groups{$k}->{bft_rmax}),
			$string);
    $worksheet -> write_blank($row, $col++, $sep);
    $worksheet -> write($row, $col++,  $groups{$k}->{plot_scale}, $integer);
    $worksheet -> write($row, $col++,  $groups{$k}->{plot_yoffset}, $number);
    ++$row;
  };

  $worksheet -> set_landscape();
  $worksheet -> set_selection(7,0); # select the first non-header cell
  $workbook -> close();		# write it out and get the hell out of dodge!
  Echo("Generating Excel report to \"$file\" ... done!");
};


sub report_ascii {
  my $how = $_[0];
  if ($how eq 'marked') {
    my $m = 0;
    map {$m += $_} values %marked;
    Error("Report aborted.  There are no marked groups."), return 1 unless ($m);
  };

  my $types = [['Text files', '.txt'], ['All Files', '*'],];
  my $path = $current_data_dir || Cwd::cwd;
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>"athena.txt",
				 -title => "Athena: Write report");
  return unless $file;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  #&push_mru($file, 0);
  Echo("Generating text report to \"$file\" ...");

  open TXT, ">".$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  print TXT "# Athena text report -- Athena version $VERSION\n",
    $groups{$current} -> project_header, "\n";

  print TXT "=" x 70, "\n",
    "Background removal parameters\n\n",
    "#  Group                  E0     Rbkg Standard        Algorithm      Elem\n",
    "# ------------------------------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    printf TXT " %-20s %9.3f %5.3f %-15.15s %-15s %-2s\n",
      $groups{$k}->{label}, $groups{$k}->{bkg_e0}, $groups{$k}->{bkg_rbkg},
	$groups{$k}->{bkg_stan},
	  ($groups{$k}->{bkg_cl}) ? "Cromer-Liberman" : "Autobk", $groups{$k}->{bkg_z};
  };
  print TXT "\n",
    "#  Group              kw E0shift Step  Fixed Fnorm Clamp1   Clamp2\n",
    "# ------------------------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    printf TXT " %-20s %1d  %7.3f %5.3f %-5s %-5s %-7s  %-7s\n",
      $groups{$k}->{label}, $groups{$k}->{bkg_kw}, $groups{$k}->{bkg_eshift},
	$groups{$k}->{bkg_step},
	  ($groups{$k}->{bkg_fixstep}) ? "yes" : "no",
	    ($groups{$k}->{bkg_fnorm}) ? "yes" : "no",
	      $groups{$k}->{bkg_clamp1}, $groups{$k}->{bkg_clamp2};
  };
  print TXT "\n",
    "#  Group                Pre-edge       Normalization   Spline       Nknots\n",
      "# ------------------------------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    my $deltak = $groups{$current}->{bkg_spl2} - $groups{$current}->{bkg_spl1};
    printf TXT " %-20s [%6.1f:%6.1f] [%6.1f:%6.1f] [%6.3f:%6.3f] %3d\n",
      $groups{$k}->{label}, $groups{$k}->{bkg_pre1}, $groups{$k}->{bkg_pre2},
	$groups{$k}->{bkg_nor1}, $groups{$k}->{bkg_nor2},
	  $groups{$k}->{bkg_spl1}, $groups{$k}->{bkg_spl2},
	    int( 2 * $deltak * $groups{$current}->{bkg_rbkg} / PI ) + 1;
  };
  print TXT "\n\n",
    "=" x 70, "\n",
    "Forward Fourier transform parameters\n\n",
    "#  Group              arbkw dk   window        k-range      Phase Correction\n",
    "# -----------------------------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    printf TXT " %-20s %1d  %3.1f %13s [%5.2f:%5.2f]   %s %-2s %-2s\n",
       $groups{$k}->{label}, $groups{$k}->{fft_arbkw}, $groups{$k}->{fft_dk},
	 $groups{$k}->{fft_win}, $groups{$k}->{fft_kmin}, $groups{$k}->{fft_kmax},
	   $groups{$k}->{fft_pc}, $groups{$k}->{bkg_z}, $groups{$k}->{fft_edge};
  };
  print TXT "\n\n",
    "=" x 70, "\n",
    "Backward Fourier transform parameters\n\n",
    "#  Group              dR     window          R-range\n",
    "# --------------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    printf TXT " %-20s %3.1f   %13s   [%5.2f:%5.2f]\n",
       $groups{$k}->{label}, $groups{$k}->{bft_dr},
	 $groups{$k}->{bft_win}, $groups{$k}->{bft_rmin}, $groups{$k}->{bft_rmax};
  };
  print TXT "\n\n",
    "=" x 70, "\n",
    "Plotting parameters\n\n",
    "#  Group              scaling factor      y-offset\n",
    "# -----------------------------------------------------\n";
  foreach my $k (&sorted_group_list) {
    next if (($how eq 'marked') and (not $marked{$k}));
    printf TXT " %-20s %-14s      %7.3f\n",
       $groups{$k}->{label}, $groups{$k}->{plot_scale}, $groups{$k}->{plot_yoffset};
  };

  close TXT;
  Echo("Generating text report to \"$file\" ... done!");
};

## END OF REPORT GENERATION SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2005 Bruce Ravel
##
##  This section of the code initializes all configuration values.
##  This file was generated from the athena.config file.


sub default_rc {
  $_[0]{general}{query_save} = 1;
  $_[0]{general}{query_constrain} = 0;
  $_[0]{general}{listside} = "right";
  $_[0]{general}{mru_limit} = 16;
  $_[0]{general}{mru_display} = "full";
  $_[0]{general}{compress_prj} = 1;
  $_[0]{general}{remember_cwd} = 0;
  $_[0]{general}{purge_stash} = 1;
  $_[0]{general}{user_key} = "comma";
  $_[0]{general}{mac_eol} = "fix";
  $_[0]{general}{interp} = "quad";
  $_[0]{general}{minpts} = 10;
  $_[0]{general}{rel2tmk} = 1;
  $_[0]{general}{autoplot} = 1;
  $_[0]{general}{autoreplot} = 0;
  $_[0]{general}{groupreplot} = "none";
  $_[0]{general}{match_as} = "perl";
  $_[0]{general}{i0_regex} = 'i(0$|o)';
  $_[0]{general}{transmission_regex} = '^i($|1$|t)';
  $_[0]{general}{fluorescence_regex} = 'i[fy]';
  $_[0]{general}{print_spooler} = ($is_windows) ? "" : "lpr";
  $_[0]{general}{ps_device} = "/cps";


  $_[0]{doc}{prefer} = "html";
  $_[0]{doc}{browser} = "firefox";
  $_[0]{doc}{zoom} = ($is_windows) ? 2 : 0;


  $_[0]{list}{x1} = 0.8;
  $_[0]{list}{x2} = 0.85;
  $_[0]{list}{y} = ($is_windows) ? 0.7 : 0.86;


  $_[0]{plot}{k_w} = "1";
  $_[0]{plot}{charsize} = 1.2;
  $_[0]{plot}{charfont} = 1;
  $_[0]{plot}{key_x} = 0.8;
  $_[0]{plot}{key_y} = 0.9;
  $_[0]{plot}{key_dy} = 0.075;
  $_[0]{plot}{bg} = "white";
  $_[0]{plot}{fg} = "black";
  $_[0]{plot}{showgrid} = 1;
  $_[0]{plot}{grid} = "grey82";
  $_[0]{plot}{c0} = "blue";
  $_[0]{plot}{c1} = "red";
  $_[0]{plot}{c2} = "green4";
  $_[0]{plot}{c3} = "darkviolet";
  $_[0]{plot}{c4} = "darkorange";
  $_[0]{plot}{c5} = "brown";
  $_[0]{plot}{c6} = "deeppink";
  $_[0]{plot}{c7} = "gold";
  $_[0]{plot}{c8} = "cyan3";
  $_[0]{plot}{c9} = "yellowgreen";
  $_[0]{plot}{linetypes} = 0;
  $_[0]{plot}{showmarkers} = 1;
  $_[0]{plot}{marker} = 9;
  $_[0]{plot}{markersize} = 2;
  $_[0]{plot}{markercolor} = "orange2";
  $_[0]{plot}{nindicators} = 8;
  $_[0]{plot}{indicatorcolor} = "violetred";
  $_[0]{plot}{indicatorline} = "solid";
  $_[0]{plot}{pointfinder} = 8;
  $_[0]{plot}{pointfindersize} = 2;
  $_[0]{plot}{pointfindercolor} = "darkseagreen4";
  $_[0]{plot}{bordercolor} = "wheat4";
  $_[0]{plot}{borderline} = "solid";
  $_[0]{plot}{emin} = -200;
  $_[0]{plot}{emax} = 800;
  $_[0]{plot}{kmin} = 0;
  $_[0]{plot}{kmax} = 15;
  $_[0]{plot}{rmin} = 0;
  $_[0]{plot}{rmax} = 6;
  $_[0]{plot}{qmin} = 0;
  $_[0]{plot}{qmax} = 15;
  $_[0]{plot}{smoothderiv} = 3;
  $_[0]{plot}{e_mu} = "m";
  $_[0]{plot}{e_mu0} = "z";
  $_[0]{plot}{e_pre} = 0;
  $_[0]{plot}{e_post} = 0;
  $_[0]{plot}{e_norm} = 0;
  $_[0]{plot}{e_der} = 0;
  $_[0]{plot}{e_marked} = "n";
  $_[0]{plot}{k_win} = 0;
  $_[0]{plot}{k_marked} = "1";
  $_[0]{plot}{r_mag} = "m";
  $_[0]{plot}{r_env} = 0;
  $_[0]{plot}{r_re} = 0;
  $_[0]{plot}{r_im} = 0;
  $_[0]{plot}{r_pha} = 0;
  $_[0]{plot}{r_win} = 0;
  $_[0]{plot}{r_marked} = "rm";
  $_[0]{plot}{q_mag} = 0;
  $_[0]{plot}{q_env} = 0;
  $_[0]{plot}{q_re} = "r";
  $_[0]{plot}{q_im} = 0;
  $_[0]{plot}{q_pha} = 0;
  $_[0]{plot}{q_win} = 0;
  $_[0]{plot}{q_marked} = "qr";


  $_[0]{bkg}{e0} = "derivative";
  $_[0]{bkg}{fraction} = 0.5;
  $_[0]{bkg}{ledgepeak} = "0";
  $_[0]{bkg}{kw} = 2;
  $_[0]{bkg}{rbkg} = 1.0;
  $_[0]{bkg}{pre1} = -150;
  $_[0]{bkg}{pre2} = -30;
  $_[0]{bkg}{nor1} = 150;
  $_[0]{bkg}{nor2} = -100;
  $_[0]{bkg}{nnorm} = "3";
  $_[0]{bkg}{step_increment} = 0.01;
  $_[0]{bkg}{flatten} = 1;
  $_[0]{bkg}{spl1} = 0.0;
  $_[0]{bkg}{spl2} = 0;
  $_[0]{bkg}{nclamp} = 5;
  $_[0]{bkg}{clamp1} = "None";
  $_[0]{bkg}{clamp2} = "Strong";


  $_[0]{clamp}{slight} = 3;
  $_[0]{clamp}{weak} = 6;
  $_[0]{clamp}{medium} = 12;
  $_[0]{clamp}{strong} = 24;
  $_[0]{clamp}{rigid} = 96;


  $_[0]{fft}{pluck_replot} = 0;
  $_[0]{fft}{arbkw} = 0.5;
  $_[0]{fft}{dk} = 1;
  $_[0]{fft}{win} = "hanning";
  $_[0]{fft}{kmin} = 2;
  $_[0]{fft}{kmax} = -2;
  $_[0]{fft}{pc} = "no";
  $_[0]{fft}{rmax_out} = 10;


  $_[0]{bft}{dr} = 0.0;
  $_[0]{bft}{win} = "hanning";
  $_[0]{bft}{rmin} = 1;
  $_[0]{bft}{rmax} = 3;


  $_[0]{xanes}{nor1} = 15;
  $_[0]{xanes}{nor2} = 0;
  $_[0]{xanes}{cutoff} = 100;


  $_[0]{calibrate}{calibrate_default} = "d";
  $_[0]{calibrate}{emin} = -20;
  $_[0]{calibrate}{emax} = 40;


  $_[0]{rebin}{emin} = -30;
  $_[0]{rebin}{emax} = 50;
  $_[0]{rebin}{pre} = 10;
  $_[0]{rebin}{xanes} = 0.5;
  $_[0]{rebin}{exafs} = 0.05;


  $_[0]{deglitch}{chie_emin} = 10;
  $_[0]{deglitch}{emax} = 10;
  $_[0]{deglitch}{margin} = 0.1;


  $_[0]{sa}{algorithm} = "fluo";
  $_[0]{sa}{emin} = -30;
  $_[0]{sa}{emax} = 100;
  $_[0]{sa}{thickness} = 10;
  $_[0]{sa}{angle_in} = 45;
  $_[0]{sa}{angle_out} = 45;


  $_[0]{mee}{enable} = 0;
  $_[0]{mee}{plot} = "k";
  $_[0]{mee}{shift} = 100;
  $_[0]{mee}{width} = 1;
  $_[0]{mee}{amp} = 0.01;
  $_[0]{mee}{choice} = "Edge";


  $_[0]{align}{align_default} = "d";
  $_[0]{align}{fit} = "d";
  $_[0]{align}{emin} = -30;
  $_[0]{align}{emax} = 100;


  $_[0]{pixel}{do_pixel_check} = 0;
  $_[0]{pixel}{emin} = -100;
  $_[0]{pixel}{emax} = 600;
  $_[0]{pixel}{resolution} = 0.5;


  $_[0]{merge}{merge_weight} = "u";
  $_[0]{merge}{plot} = "stddev";


  $_[0]{smooth}{iterations} = 10;
  $_[0]{smooth}{rmax} = 6.0;


  $_[0]{diff}{emin} = -10;
  $_[0]{diff}{emax} = 40;
  $_[0]{diff}{kmin} = 2;
  $_[0]{diff}{kmax} = 12;
  $_[0]{diff}{rmin} = 1;
  $_[0]{diff}{rmax} = 3;


  $_[0]{peakfit}{maxpeaks} = 6;
  $_[0]{peakfit}{fitmin} = -20;
  $_[0]{peakfit}{fitmax} = 20;
  $_[0]{peakfit}{emin} = -40;
  $_[0]{peakfit}{emax} = 70;
  $_[0]{peakfit}{components} = 0;
  $_[0]{peakfit}{difference} = 0;
  $_[0]{peakfit}{centroids} = 0;
  $_[0]{peakfit}{peakamp} = 0.4;
  $_[0]{peakfit}{peakwidth} = 1.0;


  $_[0]{linearcombo}{marked_query} = "set";
  $_[0]{linearcombo}{fitspace} = "e";
  $_[0]{linearcombo}{maxspectra} = 8;
  $_[0]{linearcombo}{energy} = "data";
  $_[0]{linearcombo}{grid} = 1;
  $_[0]{linearcombo}{fitmin} = -20;
  $_[0]{linearcombo}{fitmax} = 30;
  $_[0]{linearcombo}{fitmin_k} = 3;
  $_[0]{linearcombo}{fitmax_k} = 12;
  $_[0]{linearcombo}{emin} = -40;
  $_[0]{linearcombo}{emax} = 70;
  $_[0]{linearcombo}{fite0} = 0;
  $_[0]{linearcombo}{components} = 0;


  $_[0]{colors}{single} = ($is_windows) ? "red2" : "red4";
  $_[0]{colors}{marked} = ($is_windows) ? "mediumorchid" : "darkviolet";
  $_[0]{colors}{foreground} = "black";
  $_[0]{colors}{background} = "cornsilk3";
  $_[0]{colors}{inactivebackground} = "antiquewhite3";
  $_[0]{colors}{activebackground} = "cornsilk2";
  $_[0]{colors}{darkbackground} = "cornsilk3";
  $_[0]{colors}{background2} = "bisque3";
  $_[0]{colors}{activebackground2} = "bisque2";
  $_[0]{colors}{disabledforeground} = "grey50";
  $_[0]{colors}{highlightcolor} = "blue2";
  $_[0]{colors}{activehighlightcolor} = "blue3";
  $_[0]{colors}{requiresupdate} = "steelblue4";
  $_[0]{colors}{button} = "red4";
  $_[0]{colors}{activebutton} = "brown3";
  $_[0]{colors}{mbutton} = "darkviolet";
  $_[0]{colors}{activembutton} = "mediumpurple";
  $_[0]{colors}{current} = "indianred1";
  $_[0]{colors}{frozencurrent} = "palegreen2";
  $_[0]{colors}{hlist} = "white";


  $_[0]{fonts}{small} = ($is_windows) ? "Helvetica 9 normal" : "Helvetica 10 normal";
  $_[0]{fonts}{smbold} = ($is_windows) ? "Helvetica 9 bold" : "Helvetica 10 bold";
  $_[0]{fonts}{tiny} = "Helvetica 8 normal";
  $_[0]{fonts}{med} = ($is_windows) ? "Helvetica 10 normal" : "Helvetica 12 normal";
  $_[0]{fonts}{medit} = ($is_windows) ? "Helvetica 10 italic" : "Helvetica 12 italic";
  $_[0]{fonts}{bold} = ($is_windows) ? "Helvetica 10 bold" : "Helvetica 12 bold";
  $_[0]{fonts}{boldit} = ($is_windows) ? "Helvetica 10 bold italic" : "Helvetica 12 bold italic";
  $_[0]{fonts}{large} = "Helvetica 14 normal";
  $_[0]{fonts}{fixed} = ($is_windows) ? "Courier 10" : "Courier 14";
  $_[0]{fonts}{entry} = ($is_windows) ? "Courier 9" : "Courier 12";
  $_[0]{fonts}{entrybold} = ($is_windows) ? "Courier 9 bold" : "Courier 12 bold";


  return 1;
};


## END OF RC FILE SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006, 2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  setting up various parts of the display, such as menus and the
##  plot options cards


sub set_menus {

  ## ifeffit command modes:
  ##   bit 1: send to ifeffit
  ##   bit 2: store in ifeffit buffer
  ##   bit 3: display in ifeffit interaction buffer
  ##   bit 4: store in macro buffer
  ##   bit 5: write to STDOUT
  ## normal mode is 5, i.e. bits 1 and 3.

  @group_menuitems = (-menuitems =>
 		      [
		       [ command => "Copy group", -accelerator => 'Ctrl-y',
			-command => \&copy_group],
		       [ command => "Copy series",
			-command => \&series],
		       [ command => "About current group", -accelerator=>'Ctrl-b',
			-command => \&about_group],
		       [ command => "About marked groups", -accelerator=>'Ctrl-B',
			-command => sub{about_marked_groups(\%marked)}],
		       [ command => "Make detector groups", -command=>\&make_detectors,
			-state   => 'disabled'],
		       [ command => "Make background group", -command=>\&make_background,
			-state   => 'disabled'],
		       [ command => "Change group label", -accelerator => 'Ctrl-l',
			-command => \&get_new_name],
		       [ command => "Change record type",
			-command => \&change_record],
		       [ command => "Remove group",
			-command => sub{delete_group($list, $dmode, 0);}],
		       "-",
		       [ command => "Move group up", -accelerator => 'Alt-k',
			-command => \&group_up],
		       [ command => "Move group down", -accelerator => 'Alt-j',
			-command => \&group_down],
		       "-",
		       [ command => "Remove marked groups",
			-command => sub{delete_many($list, $dmode, 1)}],
		       [ command => "Close project", -accelerator=>'Ctrl-w',
			-command => \&close_project],
#		       "-",
 		      ]);


   @values_menuitems = (-menuitems =>
  		      [
		## if using Default Parameters... ----------------------------------------
		       (($use_default) ?
			(['command'=>"Set this group's values to default",
			 -command=>sub{
			   return if ($current eq "Default Parameters");
			   Echo("Resetting parameters for \`$current\' reset to Defaults");
			   $groups{$current}->set_to_another($groups{'Default Parameters'});
			   set_properties(1, $current, 0);
			   Echo(@done);}],
			['command'=>"Set marked groups'  values to default",
			 -command=>sub{
			   Echo("Parameters for marked groups reset to Default Parameters");
			   my $orig = $current;
			   foreach my $x (keys %marked) {
			     next if ($x eq 'Default Parameters');
			     next unless ($marked{$x});
			     $groups{$x}->set_to_another($groups{'Default Parameters'});
			     set_properties(1, $x, 0);
			   };
			   set_properties(1, $orig, 0);
			   Echo(@done);}],
			['command'=>"Set all groups'  values to default",
			 -command=>sub{
			   Echo("Parameters for all groups reset to Default Parameters");
			   my $orig = $current;
			   foreach my $x (keys %marked) {
			     next if ($x eq 'Default Parameters');
			     $groups{$x}->set_to_another($groups{'Default Parameters'});
			     set_properties(1, $x, 0);
			   };
			   set_properties(1, $orig, 0);
			   Echo(@done);}], ) : ()),
                ## end of this Deafult Parameters section --------------------------------

			['command'=>"Set all groups'  values to the current",
			-command=>sub{
			  Echo('No data!'), return unless ($current);
			  Echo("Parameters for all groups reset to \`$current\'");
			  my $orig = $current;
			  foreach my $x (keys %marked) {
			    next if ($x eq 'Default Parameters');
			    next if ($x eq $current);
			    $groups{$x}->set_to_another($groups{$current});
			    set_properties(1, $x, 0);
			  };
			  set_properties(1, $orig, 0);
			  Echo(@done);}],
		       ['command'=>"Set all marked groups'  values to the current",
			-command=>sub{
			  Echo('No data!'), return unless ($current);
			  Echo("Parameters for all marked groups reset to \`$current\'");
			  my $orig = $current;
			  foreach my $x (keys %marked) {
			    next if ($x eq 'Default Parameters');
			    next if ($x eq $current);
			    next unless ($marked{$x});
			    $groups{$x}->set_to_another($groups{$current});
			    set_properties(1, $x, 0);
			  };
			  set_properties(1, $orig, 0);
			  Echo(@done);}],
		       ['command'=>"Set current groups'  values to their defaults",
			-command=>sub{
			  Echo('No data!'), return unless ($current);
			  my @keys = grep {/^(bft|bkg|fft)/} (keys %widget);
			  set_params('def', @keys);
			  set_properties(1, $current, 0);
			  Echo("Reset all values for this group to their defaults");}],
		       "-",
		       ['cascade'=>'Freeze groups', -tearoff=>0,
			-menuitems=>[[ command => 'Toggle this group',    -accelerator => 'Ctrl-f',
				       -command => [\&freeze, 'this'], ],
				     [ command => 'Freeze all groups',    -accelerator => 'Ctrl-F',
				       -command => [\&freeze, 'all']],
				     [ command => 'Unfreeze all groups',  -accelerator => 'Ctrl-U',
				       -command => [\&freeze, 'none']],
				     [ command => "Freeze marked groups", -accelerator => 'Ctrl-M',
				       -command => [\&freeze, 'marked']],
				     [ command => "Unfreeze marked groups",
				       -command => [\&freeze, 'unmarked']],
				     [ command => "Freeze regex",         -accelerator => 'Ctrl-R',
				       -command => [\&freeze, 'regex']],
				     [ command => "Unfreeze regex",
				       -command => [\&freeze, 'unregex']],
				     [ command => 'Toggle all groups',
				       -command => [\&freeze, 'toggle']],
				    ]],
		       "-",
		       ["command"=>"Make current group's values the session defaults",
			-command => sub{
			  Echo("No data!"), return unless $current;
			  my @keys = grep {/^(bft|bkg|fft)/} (keys %widget);
			  session_defaults(@keys);
			  Echo("Made all values for this group the session defaults");
			}],
		       ["command"=>"Unset session defaults",
			-command => \&clear_session_defaults,
		       ],

                ## if using Default Parameters... ------------------------------------------
		       (($use_default) ?
			(['command'=>"Set Defaults to this group's values",
			  -command=>sub{
			    return if ($current eq "Default Parameters");
			    my $orig = $current;
			    Echo("Resetting Default Parameters to those of \`$current\'");
			    $groups{'Default Parameters'}->set_to_another($groups{$current});
			    set_properties(1, 'Default Parameters', 0);
			    set_properties(1, $orig, 0);
			    Echo(@done);}],) : ()),
                ## end of this Deafult Parameters section ---------------------------------

		       "-",
		       ['cascade'=>'Set E0 for THIS group to ...', -tearoff=>0,
			-menuitems=>[
				     [ command => "Ifeffit's default",
				      -command => sub{set_edge($current, 'edge');     autoreplot('e');}],
				     [ command => "zero-crossing of 2nd derivative",
				      -command => sub{set_edge($current, 'zero');     autoreplot('e');}],
				     [ command => "a set fraction of the edge step",
				      -command => sub{set_edge($current, 'fraction'); autoreplot('e');}],
				     [ command => "atomic value",
				      -command => sub{set_edge($current, 'atomic');   autoreplot('e');}],
				     [ command => "the peak of the white line",
				      -command => sub{autoreplot('e') if set_edge_peak($current);}],
				    ]],
		       ['cascade'=>'Set E0 for ALL groups to ...', -tearoff=>0,
			-menuitems=>[
				     [ command => "Ifeffit's default",
				      -command => sub{set_edges('edge', 'all');}],
				     [ command => "zero-crossing of 2nd derivative",
				      -command => sub{set_edges('zero', 'all');}],
				     [ command => "a set fraction of the edge step",
				      -command => sub{set_edges('fraction', 'all');}],
				     [ command => "atomic value",
				      -command => sub{set_edges('atomic', 'all');}],
				     [ command => "the peaks of the white lines",
				      -command => sub{set_edges('peak', 'all');}],
				    ]],
		       ['cascade'=>'Set E0 for MARKED groups to ...', -tearoff=>0,
			-menuitems=>[
				     [ command => "Ifeffit's default",
				      -command => sub{set_edges('edge', 'marked');}],
				     [ command => "zero-crossing of 2nd derivative",
				      -command => sub{set_edges('zero', 'marked');}],
				     [ command => "a set fraction of the edge step",
				      -command => sub{set_edges('fraction', 'marked');}],
				     [ command => "atomic value",
				      -command => sub{set_edges('atomic', 'marked');}],
				     [ command => "the peaks of the white lines",
				      -command => sub{set_edges('peak', 'marked');}],
				    ]],
		       "-",
		       [ command => "Tie reference channel",
			-command => \&tie_reference],
		       "-",
		       [ command => "Purge LCF results from project",
			-command => \&lcf_purge],
		      ]);

  @edit_menuitems = (-menuitems =>
		     [['command'=>"Display Ifeffit buffer", -accelerator => 'Ctrl-1',
		       -command=>sub{raise_palette('ifeffit'); $cmdbox->focus; $top->update;}],
		      ['command'=>"Show group's titles", -accelerator => 'Ctrl-2',
		       -command=>sub{raise_palette('titles');  $top->update;}],
		      ['command'=>"Edit data as text", -accelerator => 'Ctrl-3',
		       -command=>\&setup_data],
		      ['command'=>"Show group's arrays",
		       -command=>sub{Echo('No data!'), return unless ($current);
				     raise_palette('ifeffit');
				     return if ($current eq "Default Parameters");
				     $setup->dispose("show \@group $current\n", $dmode)}],
		      ['command'=>"Show all strings",
		       -command=>sub{raise_palette('ifeffit');
				     $setup->dispose("show \@strings\n", $dmode)}],
		      ['command'=>"Show all macros",
		       -command=>sub{raise_palette('ifeffit');
				     $setup->dispose("show \@macros\n", $dmode)}],
		      ['command'=>"Display echo buffer", -accelerator => 'Ctrl-4',
		       -command=>sub{raise_palette('echo'); }],
		      #"-",
		      ['command'=>"Record a macro", -accelerator => 'Ctrl-5',
		       -command=>sub{raise_palette('macro');}],
		      #['command'=>"Load a macro", -command=>\&load_macro],
		      #"-",
		      ['command'=>"Write in project journal", -accelerator => 'Ctrl-6',
		       -command=>sub{raise_palette('journal'); }],
		      ['cascade'=>"Write a report", -tearoff=>0,
		       -menuitems=>[
				    ['command'=>"Excel report (all groups)",
				     -command=>[\&report_excel, 'all']],
				    ['command'=>"Excel report (marked groups)",
				     -command=>[\&report_excel, 'marked']],
				    "-",
				    ['command'=>"CSV report (all groups)",
				     -command=>[\&report_csv, 'all']],
				    ['command'=>"CSV report (marked groups)",
				     -command=>[\&report_csv, 'marked']],
				    "-",
				    ['command'=>"text report (all groups)",
				     -command=>[\&report_ascii, 'all']],
				    ['command'=>"text report (marked groups)",
				     -command=>[\&report_ascii, 'marked']],
				    "-",
				    ['command'=>"Write an Xfit file",
				     -command=>[\&write_xfit_file]],

				   ]],
		     ]);
};


## This is very ugly, but very repititious.  On each card, there is a
## stack of frames.  In each frame there are two checkbuttons.  To the
## left is a button without text for selecting marked plots.  To the
## right is a button with text for selecting groups plots.
sub set_plotcards {

  ## colors need to be less dark on Windows than on linux.  Other unixes???
  my $red = $config{colors}{single};
  my $vio = $config{colors}{marked};

  ## energy-space options
  ## mu
  my $frame = $plotcard{e} -> Frame() -> pack(-fill=>'x');
  $frame -> Checkbutton(-text=>'mu(E)', -selectcolor=>$red, -command=>\&replot_group_e,
			-onvalue=>'m', -offvalue=>"", -variable=>\$plot_features{e_mu})
    -> grid(-row=>0, -column=>0, -pady=>0, -sticky=>'w');
  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_e,
			-value=>'e', -variable=>\$plot_features{e_marked})
    -> grid(-row=>0, -column=>1, -pady=>0, -sticky=>'w');
  ## mu0
  $frame -> Checkbutton(-text=>'background', -selectcolor=>$red, -command=>\&replot_group_e,
			-onvalue=>'z', -offvalue=>"", -variable=>\$plot_features{e_mu0})
    -> grid(-row=>1, -column=>0, -pady=>0, -sticky=>'w');
  ## pre
  $frame -> Checkbutton(-text=>'pre-edge line', -selectcolor=>$red, -command=>\&replot_group_e,
			-command=>
			sub{($plot_features{e_pre} eq 'p') and
			      (($plot_features{e_norm},$plot_features{e_der})=('',''));
			    &replot_group_e;},
			-onvalue=>'p', -offvalue=>"", -variable=>\$plot_features{e_pre})
    -> grid(-row=>2, -column=>0, -pady=>0, -sticky=>'w');
  ## post
  $frame -> Checkbutton(-text=>'post-edge line', -selectcolor=>$red,
			-command=>
			sub{($plot_features{e_post} eq 't') and
			      (($plot_features{e_norm},$plot_features{e_der})=('',''));
			    &replot_group_e;},
			-onvalue=>'t', -offvalue=>"", -variable=>\$plot_features{e_post})
    -> grid(-row=>3, -column=>0, -pady=>0, -sticky=>'w');
  ## norm
  $frame -> Checkbutton(-text=>'Normalized', -selectcolor=>$red,
			-command=>
			sub{($plot_features{e_norm} eq 'n') and
			      (($plot_features{e_pre},$plot_features{e_post})=('',''));
			    &replot_group_e;},
			-onvalue=>'n', -offvalue=>"", -variable=>\$plot_features{e_norm})
    -> grid(-row=>4, -column=>0, -pady=>0, -sticky=>'w');
  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_e,
			-value=>'n', -variable=>\$plot_features{e_marked})
    -> grid(-row=>4, -column=>1, -pady=>0, -sticky=>'w');
  ## deriv
  $frame -> Checkbutton(-text=>'Derivative', -selectcolor=>$red,
			-command=>
			sub{($plot_features{e_der} eq 'd') and
			      (($plot_features{e_pre},$plot_features{e_post})=('',''));
			    &replot_group_e;},
			-onvalue=>'d', -offvalue=>"", -variable=>\$plot_features{e_der})
    -> grid(-row=>5, -column=>0, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_e,
			-onvalue=>'d', -offvalue=>"", -variable=>\$plot_features{e_mderiv})
    -> grid(-row=>5, -column=>1, -pady=>0, -sticky=>'w');
  ## emin/emax
  my $frm = $frame -> Frame() # -> pack(-expand=>1, -fill=>'x');
    -> grid(-row=>6, -column=>0, -columnspan=>5, -padx=>1, -pady=>2, -sticky=>'we');
  $frm -> Label(-text=>'Emin:') -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{emin},
		   -state=>'normal',
		   -command=>[\&autoreplot,'e'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_emin"])
    -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{emax},
		   -state=>'normal',
		   -command=>[\&autoreplot,'e'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_emax"])
    -> pack(-side=>'right');
  $frm -> Label(-text=>'Emax:') -> pack(-side=>'right');

  ## k choices --------------------------------------------------------------
  $frame = $plotcard{k} -> Frame() -> pack(-fill=>'x', -expand=>1, -side=>'bottom');
#   $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_k,
# 			-value=>'w', -variable=>\$plot_features{k_w})
#     -> grid(-row=>0, -column=>1, -pady=>0, -sticky=>'w');
#   $frame -> Radiobutton(-text=>'chi*k^kw', -selectcolor=>$red, -command=>\&replot_group_k,
# 			-value=>'w', -variable=>\$plot_features{k_w})
#     -> grid(-row=>0, -column=>0, -pady=>0, -sticky=>'w');
#
#   $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_k,
# 			-value=>'0', -variable=>\$plot_features{k_w})
#     -> grid(-row=>1, -column=>1, -pady=>0, -sticky=>'w');
#   $frame -> Radiobutton(-text=>'chi', -selectcolor=>$red, -command=>\&replot_group_k,
# 			-value=>'0', -variable=>\$plot_features{k_w})
#     -> grid(-row=>1, -column=>0, -pady=>0, -sticky=>'w');
#
#   $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_k,
# 			-value=>'1', -variable=>\$plot_features{k_w})
#     -> grid(-row=>2, -column=>1, -pady=>0, -sticky=>'w');
#   $frame -> Radiobutton(-text=>'chi*k'  , -selectcolor=>$red, -command=>\&replot_group_k,
# 			-value=>'1', -variable=>\$plot_features{k_w})
#     -> grid(-row=>2, -column=>0, -pady=>0, -sticky=>'w');
#
#   $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_k,
# 			-value=>'2', -variable=>\$plot_features{k_w})
#     -> grid(-row=>3, -column=>1, -pady=>0, -sticky=>'w');
#   $frame -> Radiobutton(-text=>'chi*k^2', -selectcolor=>$red, -command=>\&replot_group_k,
# 			-value=>'2', -variable=>\$plot_features{k_w})
#     -> grid(-row=>3, -column=>0, -pady=>0, -sticky=>'w');
#
#   $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_k,
# 			-value=>'3', -variable=>\$plot_features{k_w})
#     -> grid(-row=>4, -column=>1, -pady=>0, -sticky=>'w');
#   $frame -> Radiobutton(-text=>'chi*k^3', -selectcolor=>$red, -command=>\&replot_group_k,
# 			-value=>'3', -variable=>\$plot_features{k_w})
#     -> grid(-row=>4, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Checkbutton(-text=>q{}, -selectcolor=>$vio, -command=>\&replot_marked_k,
			-onvalue=>'e', -offvalue=>q{}, -variable=>\$plot_features{chie})
    -> grid(-row=>4, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Plot chi(E)', -selectcolor=>$red, -command=>\&replot_group_k,
			-onvalue=>'e', -offvalue=>q{}, -variable=>\$plot_features{chie})
    -> grid(-row=>4, -column=>0, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Window', -onvalue=>'w', -offvalue=>q{}, -selectcolor=>$red,
			-variable=>\$plot_features{k_win}, -command=>\&replot_group_k,)
    -> grid(-row=>5, -column=>0, -pady=>0, -sticky=>'w');

  $frm = $frame -> Frame()
    -> grid(-row=>6, -column=>0, -columnspan=>5, -pady=>2, -sticky=>'we');
  $frm -> Label(-text=>'kmin:') -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{kmin},
		   -state=>'normal',
		   -command=>[\&autoreplot,'k'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_kmin"])
    -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{kmax},
		   -state=>'normal',
		   -command=>[\&autoreplot,'k'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_kmax"])
    -> pack(-side=>'right');
  $frm -> Label(-text=>'kmax:') -> pack(-side=>'right');


  ## R choices --------------------------------------------------------------
  $frame = $plotcard{r} -> Frame() -> pack(-fill=>'x');
  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_r,
			-value=>'rm', -variable=>\$plot_features{r_marked})
    -> grid(-row=>0, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Magnitude', -onvalue=>'m', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{r_mag},
			-command=> sub{$plot_features{r_env}=''; &replot_group_r; }, )
    -> grid(-row=>0, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Checkbutton(-text=>'Envelope', -onvalue=>'e', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{r_env},
			-command=> sub{$plot_features{r_mag}=''; &replot_group_r; }, )
    -> grid(-row=>1, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_r,
			-value=>'rr', -variable=>\$plot_features{r_marked})
    -> grid(-row=>2, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Real part', -onvalue=>'r', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{r_re}, -command=>\&replot_group_r)
    -> grid(-row=>2, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_r,
			-value=>'ri', -variable=>\$plot_features{r_marked})
    -> grid(-row=>3, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Imaginary part', -onvalue=>'i', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{r_im}, -command=>\&replot_group_r)
    -> grid(-row=>3, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_r,
			-value=>'rp', -variable=>\$plot_features{r_marked})
    -> grid(-row=>4, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Phase', -onvalue=>'p', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{r_pha}, -command=>\&replot_group_r)
    -> grid(-row=>4, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Checkbutton(-text=>'Window', -onvalue=>'w', -offvalue=>"", -selectcolor=>$red,
			      -variable=>\$plot_features{r_win}, -command=>\&replot_group_r)
    -> grid(-row=>5, -column=>0, -pady=>0, -sticky=>'w');

  $frm = $frame -> Frame() ->
    grid(-row=>6, -column=>0, -columnspan=>5, -pady=>2, -sticky=>'we');
  $frm -> Label(-text=>'Rmin:') -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{rmin},
		   -state=>'normal',
		   -command=>[\&autoreplot,'r'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_rmin"])
    -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{rmax},
		   -state=>'normal',
		   -command=>[\&autoreplot,'r'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_rmax"])
    -> pack(-side=>'right');
  $frm -> Label(-text=>'Rmax:') -> pack(-side=>'right');


  ## q choices --------------------------------------------------------------
  $frame = $plotcard{q} -> Frame() -> pack(-fill=>'x');
  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_q,
			-value=>'qm', -variable=>\$plot_features{q_marked})
    -> grid(-row=>0, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Magnitude', -onvalue=>'m', -offvalue=>"", -selectcolor=>$red,
			-command=>sub{$plot_features{q_env}=''; &replot_group_q;},
			-variable=>\$plot_features{q_mag})
    -> grid(-row=>0, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Checkbutton(-text=>'Envelope', -onvalue=>'e', -offvalue=>"", -selectcolor=>$red,
			-command=>sub{$plot_features{q_mag}=''; &replot_group_q;},
			-variable=>\$plot_features{q_env})
    -> grid(-row=>1, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_q,
			-value=>'qr', -variable=>\$plot_features{q_marked})
    -> grid(-row=>2, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Real part', -onvalue=>'r', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{q_re}, -command=>\&replot_group_q)
    -> grid(-row=>2, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_q,
			-value=>'qi', -variable=>\$plot_features{q_marked})
    -> grid(-row=>3, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Imaginary part', -onvalue=>'i', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{q_im}, -command=>\&replot_group_q)
    -> grid(-row=>3, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Radiobutton(-text=>'', -selectcolor=>$vio, -command=>\&replot_marked_q,
			-value=>'qp', -variable=>\$plot_features{q_marked})
    -> grid(-row=>4, -column=>1, -pady=>0, -sticky=>'w');
  $frame -> Checkbutton(-text=>'Phase', -onvalue=>'p', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{q_pha}, -command=>\&replot_group_q)
    -> grid(-row=>4, -column=>0, -pady=>0, -sticky=>'w');

  $frame -> Checkbutton(-text=>'Window', -onvalue=>'w', -offvalue=>"", -selectcolor=>$red,
			-variable=>\$plot_features{q_win}, -command=>\&replot_group_q)
    -> grid(-row=>5, -column=>0, -pady=>0, -sticky=>'w');

  $frm = $frame -> Frame() ->
    grid(-row=>6, -column=>0, -columnspan=>5, -pady=>2, -sticky=>'we');
  $frm -> Label(-text=>'qmin:') -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{qmin},
		   -state=>'normal',
		   -command=>[\&autoreplot,'q'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_qmin"])
    -> pack(-side=>'left');
  $frm -> RetEntry(-width=>5,
		   -textvariable=>\$plot_features{qmax},
		   -state=>'normal',
		   -command=>[\&autoreplot,'q'],
		   -validate=>'key',
		   -validatecommand=>[\&set_variable,"po_qmax"])
    -> pack(-side=>'right');
  $frm -> Label(-text=>'qmax:') -> pack(-side=>'right');

  ## Stack
  $frame = $plotcard{Stack} -> Frame() -> pack(-fill=>'x');
  $frame -> Label(-text=>"Set y-offset values for\nall MARKED groups",
		  -font=>$config{fonts}{small},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -columnspan=>2, -ipady=>5);
  $frame -> Label(-text=>"Initial value", -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $widget{sta_init} = $frame -> Entry(-width=>10, -validate=>'key',
				      -validatecommand=>[\&set_variable, 'sta_init'])
    -> grid(-row=>1, -column=>1, -sticky=>'w', -ipadx=>3);
  $frame -> Label(-text=>"Increment", -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $widget{sta_incr} = $frame -> Entry(-width=>10, -validate=>'key',
				      -validatecommand=>[\&set_variable, 'sta_incr'])
    -> grid(-row=>2, -column=>1, -sticky=>'w', -ipadx=>3);
  $widget{sta_init}->insert('end', 0);
  $widget{sta_incr}->insert('end', 0);
  $frame -> Button(-text=>'Set y-offset values',  @button_list, -borderwidth=>1,
		   -command=> [\&set_stacked_plot, $widget{sta_init}, $widget{sta_incr}],
		   )
    -> grid(-row=>3, -column=>0, -columnspan=>2, -sticky=>'ew', -pady=>3);
  $frame -> Button(-text=>'Reset',  @button_list, -borderwidth=>1,
		   -command=> [\&reset_stacked_plot, $widget{sta_init}, $widget{sta_incr}],
		   )
    -> grid(-row=>4, -column=>0, -columnspan=>2, -sticky=>'ew', -pady=>3);

  ## Plot indicators
  $plotcard{Ind} -> Label(-text=>"Plot indicators",
			  -font=>$config{fonts}{bold},
			  -foreground=>$config{colors}{activehighlightcolor})
     -> pack(-side=>'top');
  $indicator[0] = 0;
  $plotcard{Ind} -> Checkbutton(-text=>'Display indicators', -variable=>\$indicator[0], -selectcolor => $red,)
    -> pack(-expand=>1, -fill=>'x', -side=>'top');
  my $t = $plotcard{Ind} -> Scrolled('Pane',
				     -scrollbars  => 'e',
				     -width	  => 1,
				     -height	  => 1,
				     -borderwidth => 0,
				     -relief	  => 'flat')
    -> pack(-expand=>1, -fill=>'both', -side=>'top', -padx=>3, -pady=>3);
  $t -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  #BindMouseWheel($t);
  #disable_mouse3($t->Subwidget('rotext'));
  foreach my $r (1 .. $config{plot}{nindicators}) {
    $indicator[$r] = ["", " ", " "];
    $t -> Label(-text=>$r.":", -foreground=>$config{colors}{activehighlightcolor})
      -> grid(-row=>$r, -column=>0, -ipadx=>3);
    $t -> Label(-textvariable=>\$indicator[$r][1],
		-width=>3)
      -> grid(-row=>$r, -column=>1);
    my $this = $t -> Entry(-width=>10, -textvariable=>\$indicator[$r][2],
			   -validate=>'key',
			   -validatecommand=>[\&set_variable, "ind_$r"],
			  )
      -> grid(-row=>$r, -column=>2);
    $indicator[$r][0] = $t -> Button(@pluck_button, @pluck, -command=>sub{&indicator_pluck($r)})
      -> grid(-row=>$r, -column=>3);
  };

  ## Pointfinder
  $plotcard{PF} -> Label(-text=>"Point finder",
			 -font=>$config{fonts}{bold},
			 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top');
  $pointfinder{space} = $plotcard{PF} -> Label(-text=>"Last plot was in ?",
					       -font=>$config{fonts}{small})
    -> pack(-side=>'top', -pady=>2);
  $frame = $plotcard{PF} -> Frame()
    -> pack(-side=>'top');
  $frame -> Label(-text=>'X: ', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -padx=>1, -pady=>1);
  $pointfinder{'x'} = $frame -> Entry(-width=>8, -state=>'disabled',
				    -textvariable=>\$pointfinder{xvalue},
				    -validate=>'key', -validatecommand=>[\&set_variable,"pf_x"])
    -> grid(-row=>0, -column=>1, -padx=>1, -pady=>1);
  $pointfinder{xpluck} = $frame -> Button(@pluck_button, @pluck, -state=>'disabled',
					  -command=>sub{&pointfinder_pluck('x')})
    -> grid(-row=>0, -column=>2, -padx=>1, -pady=>1);
  $pointfinder{xfind} = $frame -> Button(-text=>'find Y', @button_list,
					 -state=>'disabled', -borderwidth=>1,
					 -command=>[\&pointfinder_find, 'x'])
    -> grid(-row=>0, -column=>3, -padx=>1, -pady=>1);

  $frame -> Label(-text=>'Y: ', -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -padx=>1, -pady=>1);
  $pointfinder{'y'} = $frame -> Entry(-width=>8, -state=>'disabled',
				      -textvariable=>\$pointfinder{yvalue},
				      -validate=>'key', -validatecommand=>[\&set_variable,"pf_y"])
    -> grid(-row=>1, -column=>1, -padx=>1, -pady=>1);
  $pointfinder{ypluck} = $frame -> Button(@pluck_button, @pluck, -state=>'disabled',
					  -command=>sub{&pointfinder_pluck('y')})
    -> grid(-row=>1, -column=>2, -padx=>1, -pady=>1);
  $pointfinder{yfind} = $frame -> Button(-text=>'find X', @button_list,
					 -state=>'disabled', -borderwidth=>1,)
    -> grid(-row=>1, -column=>3, -padx=>1, -pady=>1);

  $pointfinder{clear} = $frame -> Button(-text=>'Clear', @button_list,
					 -state=>'disabled', -borderwidth=>1,
					 -command=>sub{$pointfinder{xvalue}="";
						       $pointfinder{yvalue}="";})
    -> grid(-row=>2, -column=>0, -columnspan=>4, -sticky=>'ew', -padx=>1, -pady=>1);

};


sub set_stacked_plot {
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");
  my ($ini, $inc) = @_;
  my ($yvalue, $yinc) = ($ini->get(), $inc->get());
  ($yvalue = 0) if ($yvalue =~ /^\s*$/);
  ($yinc = 0)   if ($yinc   =~ /^\s*$/);
  my $message = "Set y-offsets for all marked groups starting at "
    . $yvalue . " & incrementing by " . $yinc
      . ". Now click a purple plot button.";
  my $n = 0;
  foreach my $k (&sorted_group_list) {
    next unless $marked{$k};
    ++$n;
    $groups{$k} -> MAKE(plot_yoffset=>sprintf("%.4f",$yvalue));
    $yvalue += $yinc;
  };
  set_properties (1, $current, 0);
  Error("No y-offset parameters were set because there were no marked groups."), return if ($n == 0);
  Error("Only one y-offset parameter was set because there was only one marked group."),
    return if ($n == 1);
  Echo($message);
};

sub reset_stacked_plot {
  my ($ini, $inc) = @_;
  $ini->delete(qw(0 end));
  $ini->insert('end', 0);
  $inc->delete(qw(0 end));
  $inc->insert('end', 0);
  foreach my $k (&sorted_group_list) {
    next unless $marked{$k};
    $groups{$k} -> MAKE(plot_yoffset=>0);
  };
  set_properties (1, $current, 0);
  Echo("Reset stacking parameters and y-offsets for all marked group to 0.");
};



sub indicator_pluck {
  my $which = $_[0];
  my $parent = $_[1] || $top;
  Error("You have not made a plot yet."), return 0 unless ($last_plot);

  Echonow("Select a point from the plot...");
  my ($cursor_x, $cursor_y) = (0,0);
  $indicator[$which][0] -> grab();
  $groups{$current}->dispose("cursor(crosshair=true)\n", $dmode);
  ($cursor_x, $cursor_y) = (Ifeffit::get_scalar("cursor_x"),
			    Ifeffit::get_scalar("cursor_y"));
  $groups{$current}->dispose("\n", $dmode);
  $indicator[$which][0] -> grabRelease();
  $indicator[$which][1] = ($last_plot =~ /[kq]/) ? $last_plot : uc($last_plot);
  $indicator[$which][2] = sprintf("%.3f", $cursor_x);
  Echo("Made an indicator at $indicator[$which][2] in $indicator[$which][1]");
  #$Data::Dumper::Indent = 2;
  #print Data::Dumper->Dump([\@indicator], [qw(indicator)]);
  #$Data::Dumper::Indent = 0;
};

sub pointfinder_pluck {
  my $which = $_[0];
  if ($which eq 'x') {
    Echonow("Select an x value from the plot...");
  } else {
    Echonow("Select a y value from the plot...");
  };
  $pointfinder{$which . 'pluck'}->grab();
  $groups{$current}->dispose("cursor(crosshair=true)\n", $dmode);
  my ($cursor_x, $cursor_y) = (Ifeffit::get_scalar("cursor_x"),
			       Ifeffit::get_scalar("cursor_y"));
  $groups{$current}->dispose("\n", $dmode);
  $pointfinder{$which . 'pluck'} -> grabRelease();
  if ($which eq 'x') {
    $pointfinder{xvalue} = sprintf("%.3f", $cursor_x);
    Echo("You selected an x-axis value of $pointfinder{xvalue}");
  } else {
    $pointfinder{yvalue} = sprintf("%.5f", $cursor_y);
    Echo("You selected a y-axis value of $pointfinder{yvalue}");
  };
};


sub pointfinder_find {
  Error("You haven't specified an $_[0] axis point"), return unless $pointfinder{$_[0].'value'};
  Echo("Not doing y to x yet"), return if ($_[0] eq 'y');
  my $which = $_[0];
  my $space = $$last_plot_params[2];
  my $last  = $$last_plot_params[3];
  my $group = $groups{$current}->{group};
  my $pmult = $groups{$current}->{plot_scale};
  my $yoff  = $groups{$current}->{plot_yoffset};
  my $x     = "";
  my $array = "";		# figure out what we are interpolating
                                # off of -- kinda tricky for energy space
 SWITCH: {
    ($space eq 'e') and do {
      $x = 'energy';
      ($array = "$group.flat+$yoff"),                                    last SWITCH if (($last =~ /m.*n/) and ($last !~ /d/) and $groups{$current}->{bkg_flatten});
      ($array = "$group.norm+$yoff"),                                    last SWITCH if (($last =~ /m.*n/) and ($last !~ /d/));
      ($array = "$pmult*deriv($group.flat)/deriv($group.energy)+$yoff"), last SWITCH if (($last =~ /m.*nd/) and $groups{$current}->{bkg_flatten});
      ($array = "$pmult*deriv($group.norm)/deriv($group.energy)+$yoff"), last SWITCH if  ($last =~ /m.*nd/);
      ($array = "$pmult*deriv($group.xmu)/deriv($group.energy)+$yoff"),  last SWITCH if (($last =~ /m.*d/) and ($last !~ /m.*n/));
      ($array = "$group.xmu+$yoff"),                                     last SWITCH if (($last =~ /m/) and ($last !~ /[nd]/));
      ($array = "$group.fbkg+$yoff"),                                    last SWITCH if (($last !~ /m/) and ($last =~ /z/) and $groups{$current}->{bkg_flatten});
      ($array = "$group.bkg+$yoff"),                                     last SWITCH if (($last !~ /m/) and ($last =~ /z/));
      last SWITCH;
    };
    ($space eq 'k') and do {
      $x = 'k';
      ($array = "$group.chi+$yoff"),             last SWITCH if ($last =~ /k0/);
      ($array = "$group.chi*$group.k+$yoff"),    last SWITCH if ($last =~ /k1/);
      ($array = "$group.chi*$group.k**2+$yoff"), last SWITCH if ($last =~ /k2/);
      ($array = "$group.chi*$group.k**3+$yoff"), last SWITCH if ($last =~ /k3/);
      last SWITCH;
    };
    ($space eq 'r') and do {
      $x = 'r';
      ($array = "$group.chir_mag+$yoff"), last SWITCH if ($last =~ /m/);
      ($array = "$group.chir_re+$yoff"),  last SWITCH if ($last =~ /r/);
      ($array = "$group.chir_im+$yoff"),  last SWITCH if ($last =~ /i/);
      ($array = "$group.chir_pha+$yoff"), last SWITCH if ($last =~ /p/);
      last SWITCH;
    };
    ($space eq 'q') and do {
      $x = 'q';
      ($array = "$group.chiq_mag+$yoff"), last SWITCH if ($last =~ /m/);
      ($array = "$group.chiq_re+$yoff"),  last SWITCH if ($last =~ /r/);
      ($array = "$group.chiq_im+$yoff"),  last SWITCH if ($last =~ /i/);
      ($array = "$group.chiq_pha+$yoff"), last SWITCH if ($last =~ /p/);
      last SWITCH;
    };
  };
  Error("The pointfinder cannot grab a point from the previous plot (" . join(" ", @$last_plot_params) . ")" ), return unless $array;


  $groups{$current} -> dispose("set $group.pf=$array", $dmode);
  my @x = Ifeffit::get_array("$group.$x");
  my @y = Ifeffit::get_array("$group.pf");

  if ($which eq 'x') {
    foreach my $i (0 .. $#x) {
      next if ($x[$i] < $pointfinder{xvalue});
      my $frac = ($pointfinder{xvalue} - $x[$i-1]) / ($x[$i] - $x[$i-1]);
      $pointfinder{yvalue} = sprintf("%.5f", $y[$i-1] + $frac*($y[$i] - $y[$i-1]));
      last;
    };
  } else {
    ### ????
  };
  $groups{$current} -> dispose($Ifeffit::Group::last_plot, $dmode);
  my $eshift = $groups{$current}->{bkg_eshift};

  my $command = "pmarker \"$group.$x+$eshift\", $group.pf, $pointfinder{xvalue}, $config{plot}{pointfinder}, " .
    "$config{plot}{pointfindercolor}, 0\n";
  $groups{$current} -> dispose($command, $dmode);
  $groups{$current} -> dispose("erase $group.pf", $dmode);
  Echo("Found the point ($pointfinder{xvalue},$pointfinder{yvalue})");
};


sub replot_group_e {
  return unless ($current);
  my $str = 'e';
  map {$str .= $plot_features{$_}} (qw/e_mu e_mu0 e_pre e_post e_norm e_der/);
  ($str =~ m{d\z})  and ($str .= "s" x $plot_features{smoothderiv});
  $groups{$current}->plotE($str,$dmode,\%plot_features, \@indicator);
  $last_plot='e';
  $last_plot_params = [$current, 'group', 'e', $str];
};
sub replot_marked_e {
  return unless ($current);
  $groups{$current}->plot_marked($plot_features{e_marked}, $dmode,
				 \%groups, \%marked, \%plot_features, $list,
				 \@indicator);
  $last_plot='e';
  $last_plot_params = [$current, 'marked', 'e', $plot_features{e_marked}];
};

sub replot_group_k {
  return unless ($current);
  my $str = 'k';
  map {$str .= $plot_features{$_}} (qw/k_w k_win/);
  $groups{$current}->plotk($str,$dmode,\%plot_features, \@indicator);
  $last_plot='k';
  $last_plot_params = [$current, 'group', 'k', $str];
};
sub replot_marked_k {
  return unless ($current);
  $groups{$current}->plot_marked($plot_features{k_w}, $dmode,
				 \%groups, \%marked, \%plot_features, $list,
				 \@indicator);
  $last_plot='k';
  $last_plot_params = [$current, 'marked', 'k', $plot_features{k_w}];
};

sub replot_group_r {
  return unless ($current);
  my $str = 'r';
  map {$str .= $plot_features{$_}} (qw/r_mag r_env r_re r_im r_pha r_win/);
  $groups{$current}->plotR($str,$dmode,\%plot_features, \@indicator);
  $last_plot='r';
  $last_plot_params = [$current, 'group', 'r', $str];
};
sub replot_marked_r {
  return unless ($current);
  $groups{$current}->plot_marked($plot_features{r_marked}, $dmode,
				 \%groups, \%marked, \%plot_features, $list,
				 \@indicator);
  $last_plot='r';
  $last_plot_params = [$current, 'marked', 'r', $plot_features{r_marked}];
};

sub replot_group_q {
  return unless ($current);
  my $str = 'q';
  map {$str .= $plot_features{$_}} (qw/q_mag q_env q_re q_im q_pha q_win/);
  $groups{$current}->plotq($str,$dmode,\%plot_features, \@indicator);
  $last_plot='q';
  $last_plot_params = [$current, 'group', 'q', $str];
};
sub replot_marked_q {
  return unless ($current);
  $groups{$current}->plot_marked($plot_features{q_marked}, $dmode,
				 \%groups, \%marked, \%plot_features, $list,
				 \@indicator);
  $last_plot='q';
  $last_plot_params = [$current, 'marked', 'q', $plot_features{q_marked}];
};


## END OF SETUP SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This implements the most-recently-used (MRU) file functionality


## handle the MRU stack.  Also deal with the global variables that
## keep track of the current working directory and the current project
## file name.
sub push_mru {
  my ($file, $push_file, $project, $complete) = @_;
  my ($name, $path, $suffix) = fileparse($file);

  ## set some global variables
  $current_data_dir = $path;
  ## if this is a project, then set the global project name
  ## variable. however, if the global variable is already set, then
  ## set the global variable to a single space.  the idea here is that
  ## the project name should be explicitly set upon saving in the case
  ## where projects are merged
  if ($project and $complete) {
    ##$project_name = ($project_name !~ /^\s*$/) ? " " : $file;
    $project_name = $file;
    $plot_features{project} = $project_name;
  };
  return unless ($push_file);

  ## check to see if this file is already in the sack
  my $im = $config{general}{mru_limit};
  my $ifound = 0;
  foreach my $i (1 .. $im-1) {
    next unless exists($mru{mru}{$i});
    ($ifound = $i), last if ($file eq $mru{mru}{$i});
  };
  ## if it is on the stack already, remove it and move all lower ones
  ## up
  if ($ifound) {
    foreach my $i ($ifound+1 .. $im) {
      my $j = $i - 1;
      $mru{mru}{$j} = $mru{mru}{$i};
    };
  };

  ## push each entry down in the stack
  foreach my $i (reverse(1 .. $im-1)) {
    my $j = $i + 1;
    $mru{mru}{$j} = $mru{mru}{$i};
  };
  ## push this file to the top of the stack
  $mru{mru}{1} = $file;

  ## update the mru menu
  &set_recent_menu;

  ## save the mru file
  tied(%mru) -> WriteConfig($mrufile);
};


sub set_recent_menu {
  my $menu = $file_menu -> cget('-menu') -> entrycget('Recent files', '-menu');
  $menu -> delete(0,'end');
  foreach my $i (1 .. $config{general}{mru_limit}) {
    last unless ($mru{mru}{$i});
    my $label = $mru{mru}{$i};
    ($label = basename($label)) if ($config{general}{mru_display} eq "name");
    $menu -> add('command', -label=>$label, @menu_args,
		 -command=>sub{&read_file(0, $mru{mru}{$i})});
  };
};



## END OF MRU SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  Athena's preferences dialog


sub prefs {

  my %prefs_params = ();
  &read_config(\%prefs_params);

  #$Data::Dumper::Indent = 2;
  #print Data::Dumper->Dump([\%prefs_params], [qw/prefs_params/]);
  #$Data::Dumper::Indent = 0;



  $fat_showing = 'prefs';
  $hash_pointer = \%prefs_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $prefs = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$prefs -> packPropagate(0);
  $which_showing = $prefs;

  $prefs_params{save} = 0;
  $prefs -> Label(-text=>"Edit Preferences",
		  -font=>$config{fonts}{large},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  my $labframe = $prefs -> LabFrame(-label=>'All parameters',
				    -foreground=>$config{colors}{activehighlightcolor},
				    -labelside=>'acrosstop')
    -> pack(-side=>'left', -expand=>1, -fill=>'both');
  my $tree;
  $tree = $labframe -> Scrolled('Tree',
				-scrollbars => 'se',
				-width	    => 15,
				-background => $config{colors}{hlist},
				-browsecmd  => sub{&browse_variable($tree, \%prefs_params)},
				  )
    -> pack(-expand=>1, -fill=>'both');
  $tree->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					    ($is_windows) ? () : (-width=>8));
  $tree->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					    ($is_windows) ? () : (-width=>8));

  $prefs -> Button(-text=>'Return to the main window',  @button_list,
		   -background=>$config{colors}{background2},
		   -activebackground=>$config{colors}{activebackground2},
		   -command=>sub{
		     my $response = 'No';
		     if ($prefs_params{save}) {
		       my $message = ($prefs_params{save} eq -1) ?
			 "You have applied the preferences, but have not saved them for future sessions.  Would you like to save your new preference selections?" :
			   "Would you like to apply and save your new preference selections?";
		       my $dialog =
			 $top -> Dialog(-bitmap         => 'questhead',
					-text           => $message,
					-title          => 'Athena: preferences...',
					-buttons        => ["Apply", "Apply and save", "Return"],
					-default_button => 'Return');
		       $response = $dialog->Show(-popover => 'cursor');
		     }
		     &prefs_apply(\%prefs_params) if ($response =~ /Apply/);
		     &prefs_save(\%prefs_params)  if ($response =~ /Save/);
		     &reset_window($prefs, "preferences", 0);
		     Echo("Your preferences were applied and saved to $personal_rcfile")
		       if ($response =~ /(Apply|Save)/);
		   })
    -> pack(-side=>'bottom', -fill=>'x');
  $prefs_params{future} = $prefs -> Button(-text=>'Save changes for future sessions',  @button_list,
					   -state=>'disabled',
					   -command=>sub{
					     &prefs_apply(\%prefs_params); &prefs_save(\%prefs_params);
					     $prefs_params{apply} ->configure(-state=>'disabled');
					     $prefs_params{future}->configure(-state=>'disabled');
					   } )
    -> pack(-side=>'bottom', -fill=>'x');
  $widget{prefs_future} = $prefs_params{future};
  $prefs_params{apply} = $prefs -> Button(-text=>'Apply changes to this session',  @button_list,
					  -state=>'disabled',
					  -command=>sub{
					    &prefs_apply(\%prefs_params);
					    $prefs_params{apply} ->configure(-state=>'disabled');
					  } )
    -> pack(-side=>'bottom', -fill=>'x');
  $widget{prefs_apply} = $prefs_params{apply};



  my $frame = $prefs -> Frame(-relief=>'flat')
    -> pack(-side=>'right', -expand=>1, -fill=>'both');

  $prefs_params{parameter_label} = $frame -> Label(-text=>'Parameter:  ',
						   -font=>$config{fonts}{small},
						   -justify=>'right',
						   -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $prefs_params{parameter} = $frame -> Label(-text=>'',
					     -font=>$config{fonts}{small},
					     -justify=>'left')
    -> grid(-row=>0, -column=>1, -sticky=>'ew');
  $frame -> Label(-text=>'Type:  ',
		  -font=>$config{fonts}{small},
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $prefs_params{type} = $frame -> Label(-text=>'',
					-font=>$config{fonts}{small},
					-width=>1,
					-justify=>'left')
    -> grid(-row=>1, -column=>1, -sticky=>'ew');
  $frame -> Label(-text=>"Athena's Default:  ",
		  -font=>$config{fonts}{small},
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $prefs_params{default} = $frame -> Label(-text=>'',
					   -font=>$config{fonts}{small},
					   -justify=>'left')
    -> grid(-row=>2, -column=>1, -sticky=>'ew');
  $frame -> Label(-text=>'Value:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $prefs_params{values} = $frame -> Label(-text=>'',
					  -font=>$config{fonts}{small},
					  -justify=>'left')
    -> grid(-row=>3, -column=>1, -sticky=>'ew');
  $labframe = $frame -> LabFrame(-label=>'Description',
				 -foreground=>$config{colors}{activehighlightcolor},
				 -labelside=>'acrosstop')
    -> grid(-row=>4, -column=>0, -columnspan=>2, -sticky=>'nsew',);

  $prefs_params{description} = $labframe -> Scrolled('ROText', -scrollbars=>'oe',
						     -wrap=>'word',
						     -font=>$config{fonts}{small},
						     -width=>1, -height=>18)
    -> pack(-expand=>1, -fill=>'both');
  $prefs_params{description} ->
    Subwidget("yscrollbar") ->
      configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));
  $widget{prefs_all} =
  $frame -> Button(-text=>"Set ALL params to Athena's defaults",  @button_list,
		   -command=>[\&prefs_restore_all, \%prefs_params, $tree])
    -> grid(-row=>5, -column=>0, -columnspan=>2, -sticky=>'ew');
  disable_mouse3($prefs_params{description}->Subwidget('rotext'));
  $prefs_params{description} -> tagConfigure('descr', -rmargin=>2, -spacing1=>1,
					     -lmargin1=>2, -lmargin2=>2,);
  $prefs_params{description} -> tagConfigure('warn', -rmargin=>2, -spacing1=>1,
					     -lmargin1=>2, -lmargin2=>2,
					     -foreground=>'red3',);
  $prefs_params{description} -> tagConfigure('units', -rmargin=>2, -spacing1=>1,
					     -lmargin1=>2, -lmargin2=>2,
					     -foreground=>'green4',);
  $prefs_params{description} -> tagConfigure('restart', -rmargin=>2, -spacing1=>1,
					     -lmargin1=>2, -lmargin2=>2,
					     -foreground=>'darkviolet',);

  foreach my $s (@{$prefs_params{order}}) {
    $tree -> add($s, -text=>$s);
    foreach my $v (@{$prefs_params{$s}{order}}) {
      my $this = $s.".".$v;
      $tree -> add($this, -text=>$v);
      $tree -> setmode($this, 'none');
      $prefs_params{$s}{$v}{new} = $config{$s}{$v};
    };
    $tree -> setmode($s, 'close');
    $tree -> close($s);

  };
  $tree->autosetmode();

  ## save, so it can be unbound if changed (this is the global variable)
  $user_key = $config{general}{user_key};

  $top -> update;
};


sub browse_variable {
  my ($tree, $rhash) = @_;
  my $this = $tree->infoAnchor;
  return unless $this;
  my ($s, $v) = split(/\./, $this);

  my $frame = $$rhash{values}->parent;
  return unless $s;
  unless ($v) {
    $$rhash{parameter_label} -> configure(-text=>"Section:  ");
    $$rhash{parameter}   -> configure(-text=>$s);
    $$rhash{type}        -> configure(-text=>"");
    $$rhash{default}     -> configure(-text=>"");
    $$rhash{description} -> delete(qw(1.0 end));
    $$rhash{description} -> insert('end', $$rhash{$s}{description}, 'descr');
    $$rhash{default} -> gridForget();
    $$rhash{default} = $frame -> Label(-text=>'', -justify=>'left')
      -> grid(-row=>2, -column=>1, -padx=>2, -sticky=>'ew');
    $$rhash{values} -> gridForget();
    $$rhash{values} = $frame -> Label(-text=>'',)
      -> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
    #$tree -> open($this) if ($tree->getmode($this) eq 'open');
    return;
  };

  $$rhash{values} -> gridForget();
  ##$$rhash{values} -> bind('<Any-KeyPress>');
  $$rhash{parameter_label} -> configure(-text=>"Parameter:  ");
  $$rhash{parameter} -> configure(-text=>$v);
  $$rhash{type}      -> configure(-text=>$$rhash{$s}{$v}{type});
  $$rhash{default} -> gridForget();
  $$rhash{default} = $frame -> Button(-text=>"", -borderwidth=>1,
				      -command=>sub{
					## restore the default value
					$$rhash{$s}{$v}{new} = $$rhash{$s}{$v}{default};
					$$rhash{$s}{$v}{new} = $$rhash{$s}{$v}{windows}
					  if (exists $$rhash{$s}{$v}{windows} and $is_windows);
					if ($$rhash{$s}{$v}{type} eq 'boolean') {
					  $$rhash{$s}{$v}{new} = ($$rhash{$s}{$v}{new} eq 'true') ? $$rhash{$s}{$v}{onvalue} : 0;
					} elsif ($$rhash{$s}{$v}{type} eq 'keypress') {
					  $$rhash{values} -> delete(0, 'end');
					  $$rhash{values} -> insert('end', $$rhash{$s}{$v}{new});
					};
					$$rhash{save} = 1;
					$$rhash{apply} ->configure(-state=>'normal');
					$$rhash{future}->configure(-state=>'normal');
					## and make sure it is displayed properly
					$tree -> KeyboardBrowse;
				      })
    -> grid(-row=>2, -column=>1, -padx=>2, -sticky=>'ew');
  if (exists $$rhash{$s}{$v}{windows} and $is_windows) {
    $$rhash{default}   -> configure(-text=>$$rhash{$s}{$v}{windows});
  } else {
    $$rhash{default}   -> configure(-text=>$$rhash{$s}{$v}{default});
  };
  #$$rhash{parameter} -> configure(-text=>$v);
  $$rhash{description} -> delete(qw(1.0 end));
  $$rhash{description} -> insert('end', $$rhash{$s}{$v}{description}, 'descr');
  if ($s eq 'fonts') {
    my $rcfile = $groups{"Default Parameters"} -> find('athena', 'rc_personal');
    $$rhash{description} -> insert('end', "\n\nFonts cannot currently be changed interactively.  You will need to edit $rcfile by hand.", 'warn');
  } elsif ($$rhash{$s}{$v}{type} eq 'color') {
    $$rhash{description} -> insert('end', "\n\nPress the colored \"Value\" button to change this color.", 'descr');
  } elsif ($$rhash{$s}{$v}{type} eq 'regex') {
    $$rhash{description} -> insert('end', "\n\nThis parameter must be a valid Perl regular expression.", 'warn');
  };

  ##$$rhash{description} -> insert('end', "\n\nMost color changes (with the exception of the \"current\" color) do not take effect until the next time Athena is started.  That will be fixed in a future version of Athena.", 'descr')
  ##  if ($s eq 'colors');

  $$rhash{description} -> insert('end', "\n\nThe units of this parameter are $$rhash{$s}{$v}{units}.", 'units')
    if (exists $$rhash{$s}{$v}{units});
  $$rhash{description} -> insert('end', "\n\nYou must restart Athena to see the effect of changing this parameter.", 'restart')
    if (exists $$rhash{$s}{$v}{restart} and (not (($s eq 'fonts') or ($$rhash{$s}{$v}{type} eq 'font'))));

  $$rhash{description} -> insert('end', "\n\nPress the \"Default\" button to restore Athena's default value for this variable.", 'descr');

 SWITCH: {
    ($$rhash{$s}{$v}{type} eq 'string') and do {
      $$rhash{values} = $frame -> Entry(-width=>12, -validate=>'key',
					-validatecommand=>[\&prefs_string, join(".", $s,$v), $rhash])
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      $$rhash{values} -> configure(-validate=>'none');
      $$rhash{values} -> insert('end', $$rhash{$s}{$v}{new});
      $$rhash{values} -> configure(-validate=>'key');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'regex') and do {
      $$rhash{values} = $frame -> Entry(-width=>12, -validate=>'key',
					-validatecommand=>[\&prefs_string, join(".", $s,$v), $rhash])
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      $$rhash{values} -> configure(-validate=>'none');
      $$rhash{values} -> insert('end', $$rhash{$s}{$v}{new});
      $$rhash{values} -> configure(-validate=>'key');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'real') and do {
      $$rhash{values} = $frame -> Entry(-width=>12, -validate=>'key',
					-validatecommand=>[\&prefs_real, join(".", $s,$v), $rhash])
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      $$rhash{values} -> configure(-validate=>'none');
      $$rhash{values} -> insert('end', $$rhash{$s}{$v}{new});
      $$rhash{values} -> configure(-validate=>'key');
      last SWITCH;
    };
    ## need to set the save flag
    ($$rhash{$s}{$v}{type} eq 'positive integer') and do {
      $$rhash{values} = $frame -> NumEntry(-width	 => 4,
					   -orient	 => 'horizontal',
					   -foreground	 => $config{colors}{foreground},
					   -textvariable => \$$rhash{$s}{$v}{new},
					   -minvalue	 => $$rhash{$s}{$v}{minint}||0,
					   -maxvalue	 => $$rhash{$s}{$v}{maxint},
					   -browsecmd	 => [\&prefs_modified, $rhash],
					   -command	 => [\&prefs_modified, $rhash],
					  )
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'w');
      $$rhash{values} -> configure( -value=>$$rhash{$s}{$v}{new});
      ## crufty solution to the lack of a callback for NumEntry
      $$rhash{apply}  -> configure(-state=>'normal');
      $$rhash{future} -> configure(-state=>'normal');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'list') and do {
      my @vals = split(" ", $$rhash{$s}{$v}{values});
      $$rhash{values} = $frame -> Optionmenu(-font=>$config{fonts}{small},
					     -borderwidth=>1,
					     -textvariable=>\$$rhash{$s}{$v}{new}
					     )
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      foreach my $vl (@vals) {
	$$rhash{values} -> command(-label => $vl,
				   -command=>sub{$$rhash{$s}{$v}{new}=$vl;
						 $$rhash{save} = 1;
						 $$rhash{apply} ->configure(-state=>'normal');
						 $$rhash{future}->configure(-state=>'normal');
					       } );
      };
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'boolean') and do {
      $$rhash{values} = $frame -> Checkbutton(-text=>$v,
					      -onvalue=>$$rhash{$s}{$v}{onvalue},
					      -offvalue=>$$rhash{$s}{$v}{offvalue}||0,
					      -selectcolor=> $config{colors}{single},
					      -variable=>\$$rhash{$s}{$v}{new},
					      -command=>
					      sub{
						$$rhash{apply} ->configure(-state=>'normal');
						$$rhash{future}->configure(-state=>'normal');
						$$rhash{save} = 1;
					      })
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'keypress') and do {
      $$rhash{values} = $frame -> Entry(-width=>12, -justify=>'center')
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      $$rhash{values} -> insert('end', $$rhash{$s}{$v}{new});
      $$rhash{values} -> bind('<Any-KeyPress>' => sub
			      {
				my($c) = @_;
				my $e = $c->XEvent;
				my $keysym = $e->K;
				$$rhash{$s}{$v}{new} = $keysym;
				$$rhash{values} -> delete(0, 'end');
				$$rhash{values} -> insert('end', $keysym);
				$$rhash{save} = 1;
				$$rhash{apply} ->configure(-state=>'normal');
				$$rhash{future}->configure(-state=>'normal');
			      });
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'color') and do {
      my $color = $$rhash{$s}{$v}{new};
      my ($r, $g, $b) = $frame -> rgb($color);
      #print join(" ", $color, $r, $g, $b), $/;
      my $acolor = sprintf("#%4.4x%4.4x%4.4x", int($r*0.85), int($g*0.85), int($b*0.85));
      ($acolor = "#300030003000") if ($acolor eq "#000000000000");
      #print $acolor, $/;
      $$rhash{values} = $frame -> Button(-background=>$color,
					 -activebackground=>$acolor,
					 -borderwidth=>1,
					 -command=>sub{
					   my $color = "";
					   #$top->Busy(-recurse=>1);
					   $color = $$rhash{values}->chooseColor(-initialcolor=>$$rhash{$s}{$v}{new});
					   #$top->Unbusy;
					   return unless defined($color);
					   $$rhash{values}->configure(-background=>$color,
								      -activebackground=>$color);
					   $$rhash{$s}{$v}{new}=$color;
					   $$rhash{save} = 1;
					   $$rhash{apply} ->configure(-state=>'normal');
					   $$rhash{future}->configure(-state=>'normal');
					 })
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'font') and do {
      $$rhash{values} = $frame -> Button(-foreground=>'black',
					 -borderwidth=>1,
					 -text=>'abc ABC 123',
					 -font=>$$rhash{$s}{$v}{new},
					 -command=>sub{Error("Changing fonts interactively is not yet supported.  You can edit ".$groups{'Default Parameters'} -> find('athena', 'rc_personal')." by hand.")})
	-> grid(-row=>3, -column=>1, -padx=>2, -sticky=>'ew');
      last SWITCH;
    };

  };
};


## validate command for a string type variable (no restrictions)
sub prefs_string {
  my ($k, $hash, $entry) = (shift, shift, shift);
  my ($s, $v) = split(/\./, $k);
  $$hash{$s}{$v}{new} = $entry;
  $$hash{save} = 1;
  $$hash{apply} ->configure(-state=>'normal');
  $$hash{future}->configure(-state=>'normal');
  #print join(" ", ">>>", $s, $v, $$hash{save}, $$hash{$s}{$v}, $/);
  return 1;
};
sub prefs_modified {
  my $hash = shift;
  $$hash{save} = 1;
  $$hash{apply} ->configure(-state=>'normal');
  $$hash{future}->configure(-state=>'normal');
  return 1;
};

## validate command for a real type variable (must be a +/-real)
sub prefs_real {
  my ($k, $hash, $entry) = (shift, shift, shift);
  my ($s, $v) = split(/\./, $k);
  #print join(" ", $s, $v, $entry, $hash, $/);
  ($entry =~ /^\s*$/) and ($entry = 0);	# error checking ...
  ($entry =~ /^\s*-$/) and return 1;	# error checking ...
  ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
  $$hash{$s}{$v}{new} = $entry;
  $$hash{save} = 1;
  $$hash{apply} ->configure(-state=>'normal');
  $$hash{future}->configure(-state=>'normal');
  #print join(" ", ">>>", $s, $v, $$hash{save}, $$hash{$s}{$v}, $/);
  return 1;
};

sub prefs_restore_all {
  my ($rhash, $tree) = @_;

  my $message = "Are you sure that you wish to restore ALL the default values, overwriting any configuration you may have already made to Athena?  Doing so will only restore them within this dialog.  You will then need to click the buttons below to apply or save the default values.";
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => $message,
		   -title          => 'Athena: preferences...',
		   -buttons        => [qw/Yes No/],
		   -default_button => 'Yes');
  my $response = $dialog->Show();
  unless ($response eq 'Yes') {
    return;
  };
  foreach my $s (@{$$rhash{order}}) {
    foreach my $v (@{$$rhash{$s}{order}}) {
      $$rhash{$s}{$v}{new} = $$rhash{$s}{$v}{default};
      $$rhash{$s}{$v}{new} = $$rhash{$s}{$v}{windows}
	if (exists $$rhash{$s}{$v}{windows} and $is_windows);
      if ($$rhash{$s}{$v}{type} eq 'boolean') {
	$$rhash{$s}{$v}{new} = ($$rhash{$s}{$v}{new} eq 'true') ? $$rhash{$s}{$v}{onvalue} : 0;
      };
    };
  };
  $$rhash{save} = 1;
  $$rhash{apply} ->configure(-state=>'normal');
  $$rhash{future}->configure(-state=>'normal');
  ## and make sure it is displayed properly
  $tree -> KeyboardBrowse;
  Echo("Restored ALL parameter defaults.  Click the apply or save buttons to use these defaults.");
};


sub prefs_apply {
  my $rhash = $_[0];

  my %old = (charsize => $config{plot}{charsize},
	     charfont => $config{plot}{charfont},
	     mru_display => $config{general}{mru_display},
	    );

  foreach my $s (@{$$rhash{order}}) {
    foreach my $v (@{$$rhash{$s}{order}}) {
      $config{$s}{$v} = $$rhash{$s}{$v}{new};
    };
  };
  $$rhash{save} = -1;

  ## certain parameters need to take effect immediately and so require
  ## some special care

  ## set various plotting defaults
  my @fclist;
  map {push @fclist, "color".$_, $config{plot}{'c'.$_}} (0 ..9);
  my $screen = ", fg=$config{plot}{fg}, bg=$config{plot}{bg}, ";
  $screen .= ($config{plot}{showgrid}) ? "grid, gridcolor=\"$config{plot}{grid}\"" : "nogrid";
  $setup -> SetDefault(screen=>$screen,
		       @fclist,
		       'showmarkers',        $config{plot}{showmarkers},
		       'marker',             $config{plot}{marker},
		       'markersize',         $config{plot}{markersize},
		       'markercolor',        $config{plot}{markercolor},
		       #'indicator',          $config{plot}{indicator},
		       'indicatorcolor',     $config{plot}{indicatorcolor},
		       'indicatorline',      $config{plot}{indicatorline},
		       'bordercolor',        $config{plot}{bordercolor},
		       'borderline',         $config{plot}{borderline},
		       'linetypes',          $config{plot}{linetypes},
		       'interp',             $config{general}{interp},);
  &set_key_params;
  ## set default analysis parameter values
  $setup -> SetDefault(bkg_kw	  => $config{bkg}{kw},
		       bkg_rbkg	  => $config{bkg}{rbkg},
		       bkg_pre1	  => $config{bkg}{pre1},
		       bkg_pre2	  => $config{bkg}{pre2},
		       bkg_nor1	  => $config{bkg}{nor1},
		       bkg_nor2	  => $config{bkg}{nor2},
		       bkg_nnorm  => $config{bkg}{nnorm},
		       bkg_spl1	  => $config{bkg}{spl1},
		       bkg_spl2	  => $config{bkg}{spl2},
		       bkg_nclamp => $config{bkg}{nclamp},
		       bkg_clamp1 => $config{bkg}{clamp1},
		       bkg_clamp2 => $config{bkg}{clamp2},
		       fft_arbkw  => $config{fft}{arbkw},
		       fft_dk	  => $config{fft}{dk},
		       fft_win	  => $config{fft}{win},
		       fft_kmin	  => $config{fft}{kmin},
		       fft_kmax	  => $config{fft}{kmax},
		       fft_pc	  => $config{fft}{pc},
		       bft_dr	  => $config{bft}{dr},
		       bft_win	  => $config{bft}{win},
		       bft_rmin	  => $config{bft}{rmin},
		       bft_rmax	  => $config{bft}{rmax},
		      );
  ## handle general.listside parameter
  &swap_panels unless
    (grep {$_ eq $config{general}{listside}} ($skinny -> packInfo()));
  ## deal with the toggle in the Merge menu
  $merge_weight = ($config{merge}{merge_weight} eq 'u') ? 'Weight by importance' : 'Weight by chi_noise';
  ## turn on/off the dispersive data conversion
  $data_menu -> menu -> entryconfigure(3, -state=>($config{pixel}{do_pixel_check}) ?
				       'normal' : 'disabled');
  ## handle general.projectbar parameter
  #if ($config{general}{projectbar} eq 'none') {
  #  $projectbar -> packForget;
  #} elsif ($config{general}{projectbar} eq 'file') {
  #  $project_label -> configure(-textvariable=>\$project_name);
  #  $projectbar -> pack(-side=>"top", -anchor=>'nw', -fill=>'x', -after=>$menubar)
  #};

  ## bring the edge step widget up to date
  $widget{bkg_step} -> configure(-increment=>$config{bkg}{step_increment});

  ## make sure that the default plot style is up to date
  foreach my $k (keys %plot_features) {
    next unless ($k =~ /^[ekqr](_|ma|mi)/);
    $plot_styles{default}{$k} = $plot_features{$k};
  };
  tied(%plot_styles) -> WriteConfig($groups{"Default Parameters"} -> find('athena', 'plotstyles'));
  $plot_features{smoothderiv} =$config{plot}{smoothderiv};


  ## user configured, user defined key sequences (yikes!)
  my $this_key = "<Control-" . $config{general}{user_key} . ">";
  my $old_key  = "<Control-" . $user_key . ">";
  $top -> bind($old_key, "");
  $top -> bind($this_key => [\&keys_dispatch, 'control']);
  $this_key = "<Meta-" . $config{general}{user_key} . ">";
  $old_key  = "<Meta-" . $user_key . ">";
  $top -> bind($old_key, "");
  $top -> bind($this_key => [\&keys_dispatch, 'meta']);
  $this_key = "<Alt-" . $config{general}{user_key} . ">";
  $old_key  = "<Alt-" . $user_key . ">";
  $top -> bind($old_key, "");
  $top -> bind($this_key => [\&keys_dispatch, 'meta']);

  &set_recent_menu if ($old{mru_display} ne $config{general}{mru_display});

  ## add any special handling of configuration parameters here
  $Ifeffit::Group::rmax_out = $config{fft}{rmax_out};
  $groups{"Default Parameters"} -> dispose("plot(charsize=$config{plot}{charsize}, charfont=$config{plot}{charfont})", $dmode)
    if (($old{charsize} != $config{plot}{charsize}) or ($old{charfont} != $config{plot}{charfont}));

  foreach (qw(slight weak medium strong rigid)) {
    $groups{"Default Parameters"} -> set_clamp(ucfirst($_), $config{clamp}{$_});
  };

  Echo("Applied new preferences to current session.");
};

sub prefs_save {
  my $rhash = $_[0];
  rename $personal_rcfile, $personal_rcfile.".bak";
  my $config_ref = tied %config;
  $config_ref -> WriteConfig($personal_rcfile);
  $$rhash{save} = 0;
  Echo("Saved preferences to \"$personal_rcfile\"");
};


sub read_config {
  my $rhash = $_[0];
  my $config_file = $groups{"Default Parameters"} -> find('athena', 'config');
  ##$config_file = "Ifeffit/lib/athena.config";
  return -1 unless (-e $config_file);

  $$rhash{order} = [];
  my ($current_section, $current_variable) = ("", "");
  Echo("Reading master configuration file ...");
  open C, $config_file or die "could not open $config_file for reading\n";
  while (<C>) {
    next if (/^\s*$/);		# blank line
    next if (/^\s*\#/);		# comment line
    chomp;
  SWITCH: {
      ## recognize a new section of variables
      (/^section=/) and do {
	my @line = split(/=/, $_);
	push @{$$rhash{order}}, $line[1];
	$$rhash{$line[1]} = {};
	$current_section = $line[1];
	last SWITCH;
      };
      ## read the description of the current section of variables
      (/^section_description/) and do {
	$$rhash{$current_section}{description} = "";
	my $next = <C>;
	while ($next !~ /^\s*$/) {
	  chomp $next;
	  $$rhash{$current_section}{description} .= substr($next, 1);
	  $next = <C>;
	};
	$$rhash{$current_section}{description} =
	  substr($$rhash{$current_section}{description}, 1);
	last SWITCH;
      };
      ## recognize a new variable
      (/^variable=/) and do {
	my @line = split(/=/, $_);
	push @{$$rhash{$current_section}{order}}, $line[1];
	$$rhash{$current_section}{$line[1]} = {};
	$current_variable = $line[1];
	last SWITCH;
      };
      ## read the description of the current variable
      (/^description/) and do {
	$$rhash{$current_section}{$current_variable}{description} = "";
	my $next = <C>;
	while ($next !~ /^\s*$/) {
	  chomp $next;
	  $next =~ s/^ *\.\s*$/\n\n\n/;
	  $next =~ s/^ *\./\n\n  /;
	  $$rhash{$current_section}{$current_variable}{description} .= substr($next, 1);
	  $next = <C>;
	};
	$$rhash{$current_section}{$current_variable}{description} =
	  substr($$rhash{$current_section}{$current_variable}{description}, 1);
	last SWITCH;
      };
      ## the type (i.e. string, boolean, etc) of the current variable
      (/^type=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{type} = $line[1];
	last SWITCH;
      };
      ## default value
      (/^default=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{default} = $line[1];
	last SWITCH;
      };
      ## list values
      (/^values=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{values} = $line[1];
	last SWITCH;
      };
      ## special treatment for windows
      (/^windows=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{windows} = $line[1];
	last SWITCH;
      };
      ## max value for a positive integer
      (/^maxint=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{maxint} = $line[1];
	last SWITCH;
      };
      ## min value for a positive integer
      (/^minint=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{minint} = $line[1];
	last SWITCH;
      };
      ## boolean for whether a font may be variable width
      (/^variable_width=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{variable_width} = $line[1];
	last SWITCH;
      };
      ## value for boolean true
      (/^onvalue=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{onvalue} = $line[1];
	last SWITCH;
      };
      ## value for boolean false if not 0
      (/^offvalue=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{offvalue} = $line[1];
	last SWITCH;
      };
      ## restart required
      (/^restart=/) and do {
	my @line = split(/=/, $_);
	($line[1] = 0) if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{restart} = $line[1];
	last SWITCH;
      };
      ## parameter units
      (/^units=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{units} = $line[1];
	last SWITCH;
      };
      ## callback string for list or boolean
      (/^callback=/) and do {
	my @line = split(/=/, $_);
	($line[1] = " ") if ($line[1] eq '""');
	$$rhash{$current_section}{$current_variable}{callback} = $line[1];
	last SWITCH;
      };
    };
  };

  close C;
  Echo("Reading master configuration file ... done!");

};
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  Athena's plugin registry

sub registry {

  my %reg_params = ();

  $fat_showing = 'registry';
  $hash_pointer = \%reg_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $reg = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  $which_showing = $reg;

  $reg -> Label(-text=>"Plugin Registry",
		-font=>$config{fonts}{large},
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## table of available plugins
  my $plugin_list;
  $plugin_list = $reg -> Scrolled('HList',
				  -scrollbars	    => 'osoe',
				  -header	    => 1,
				  -columns	    => 3,
				  -borderwidth	    => 0,
				  -relief           => 'flat',
				  -cursor           => $mouse_over_cursor,
				  -selectbackground => $config{colors}{background},
				  -highlightcolor   => $config{colors}{background},
				  -browsecmd        =>
				  sub {	# Echo a bit of info on a click
				    my $pick = $plugin_list -> selectionGet;
				    ($pick = $pick->[0]) if (ref($pick) =~ /ARRAY/); # Tk 800 returns a scalar
				                                                     # Tk 804 returns an array ref
				    my $id = "Ifeffit/Plugins/Filetype/Athena/".$plugins[$pick].".pm";
				    my $message = ($INC{$id})
				      ? "System plugin: $INC{$id}"
					: "Private plugin: " . File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'userfiletypedir'), $plugins[$pick].".pm");
				    Echo($message);
				  },
				  -command          =>
				  sub {	# display pod on double-click
				    my $pick = $plugin_list -> selectionGet;
				    ($pick = $pick->[0]) if (ref($pick) =~ /ARRAY/); # Tk 800 returns a scalar
				                                                     # Tk 804 returns an array ref
				    my $id = "Ifeffit/Plugins/Filetype/Athena/".$plugins[$pick].".pm";
				    my $file = $INC{$id} || File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'userfiletypedir'), $plugins[$pick].".pm");
				    pod_display($file);
				  })
    -> pack(-side=>'top', -fill =>'both', -expand=>1, -padx=>4, -pady=>4);
  $plugin_list -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $plugin_list -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $plugin_list -> Subwidget("hlist")
    -> bind('<ButtonPress-2>', sub{anchor_registry($plugin_list)});
  $plugin_list -> Subwidget("hlist")
    -> bind('<ButtonPress-3>', sub{anchor_registry($plugin_list)});

  my $style = $plugin_list -> ItemStyle('text',
					-font=>$config{fonts}{small},
					-anchor=>'w',
					-foreground=>$config{colors}{activehighlightcolor});
  $plugin_list -> headerCreate(0,
			       -text=>q{}, # Enable button
			       -style=>$style,
			       -headerbackground=>$config{colors}{background},);
  $plugin_list -> headerCreate(1,
			       -text=>"Plugin",
			       -style=>$style,
			       -headerbackground=>$config{colors}{background},);
  $plugin_list -> headerCreate(2,
			       -text=>"Description",
			       -style=>$style,
			       -headerbackground=>$config{colors}{background},);

  $style = $plugin_list -> ItemStyle('text',
				     -font=>$config{fonts}{small},
				     -anchor=>'w',
				     -foreground=>$config{colors}{foreground});

  my @button = ();
  foreach my $i (0 .. $#plugins) {
    $plugin_list -> add($i);
    $button[$i] = $plugin_list -> Checkbutton(-variable    => \$plugin_params{$plugins[$i]}{_enabled},
					      -selectcolor => $config{colors}{single},
					      -command     => sub{ # Enable plugin
						my $file = $groups{"Default Parameters"} -> find('athena', 'plugins');
						tied( %plugin_params )->WriteConfig($file);
						if ($plugin_params{$plugins[$i]}{_enabled}) {
						  Echo("Registered plugin $plugins[$i] for use.");
						} else {
						  Echo("Un-registered plugin $plugins[$i].");
						};
					      },
					     );
    $plugin_list -> itemCreate($i, 0, -itemtype=>'window', -widget=>$button[$i]);
    $plugin_list -> itemCreate($i, 1, -itemtype=>'text',   -text=>$plugins[$i], -style=>$style);
    my $description = eval "\$Ifeffit::Plugins::Filetype::Athena::$plugins[$i]::description";
    $plugin_list -> itemCreate($i, 2, -itemtype=>'text',   -text=>$description, -style=>$style);
  };

  ## utilities at bottom of page
  $reg -> Button(-text		   => 'Return to the main window',
		 @button_list,
		 -background	   => $config{colors}{background2},
		 -activebackground => $config{colors}{activebackground2},
		 -command	   => sub{ &reset_window($reg, "plugin registry", 0) })
    -> pack(-side=>'bottom', -fill=>'x');
  $reg -> Button(-text=>'Document section: plugins', @button_list,
		 -command=>sub{pod_display("import::plugin.pod")})
    -> pack(-side=>'bottom', -fill=>'x');
  my $fr = $reg -> Frame()
    -> pack(-side=>'bottom', -fill=>'x');
  $fr -> Button(-text    => 'Register all',
		-width   => 12,
		-command => sub{
		  foreach my $i (0..$#plugins) { $button[$i] -> select; };
		  my $file = $groups{"Default Parameters"} -> find('athena', 'plugins');
		  tied( %plugin_params )->WriteConfig($file);
		  Echo("Registered all plugins for use.");
		})
    -> pack(-side=>'left', -fill=>'x', -expand=>1);
  $fr -> Button(-text    => 'Un-register all',
		-width   => 12,
		-command => sub{
		  foreach my $i (0..$#plugins) { $button[$i] -> deselect; };
		  my $file = $groups{"Default Parameters"} -> find('athena', 'plugins');
		  tied( %plugin_params )->WriteConfig($file);
		  Echo("Un-registered all plugins.");
		})
    -> pack(-side=>'left', -fill=>'x', -expand=>1)

};

  sub anchor_registry {
    ## this first bit swiped from HList.pm
    my $w = shift;
    my $Ev = $w->XEvent;
    delete $w->{'shiftanchor'};
    #my $entry = $w->GetNearest($Ev->y, 1);
    my $entry = $w->nearest($Ev->y);
    return unless (defined($entry) and ($entry >= 0));
    print $entry, $/;
    $w->anchorSet($entry);
    $w->selectionSet($entry);
    my $pick = $w -> selectionGet;
    ($pick = $pick->[0]) if (ref($pick) =~ /ARRAY/); # Tk 800 returns a scalar
                                                     # Tk 804 returns an array ref
    my $id = "Ifeffit/Plugins/Filetype/Athena/".$plugins[$pick].".pm";
    my $file = $INC{$id} || File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'userfiletypedir'), $plugins[$pick].".pm");
    pod_display($file);
  };



## END OF PLUGIN REGISTRY SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  key bindings

sub set_key_data {
  %key_data = (File =>
	       {
		a001 =>
		["Open file",                        sub{read_file(0)},               "any", 'Ctrl-o'],
		a004 =>
		["Open many files",                  sub{read_file(1)},               "any", 'Alt-o'],
		a008 =>
		["Open most recent file",            sub{read_file(0, $mru{mru}{1})}, "any"],
		a011 =>
		["Open second most recent file",     sub{read_file(0, $mru{mru}{2})}, "any"],
		a014 =>
		["Open third most recent file",      sub{read_file(0, $mru{mru}{3})}, "any"],
		a018 =>
		["Open fourth most recent file",     sub{read_file(0, $mru{mru}{4})}, "any"],
		a021 =>
		["Open URL",                         \&fetch_url,                     "any"],
		a024 =>
		["Save entire project",              sub{&save_project('all quick')}, "any", 'Ctrl-s'],
		a028 =>
		["Save entire project as",           sub{&save_project('all')},       "any"],
		a031 =>
		["Save marked groups as a project" , sub{&save_project('marked')},    "any"],
		a033 =>
		['Prompt for save space',            sub{&dispatch_space('save')},    "any"],
		a034 =>
		['Save mu(E)',                       sub{save_chi('e')},              "any"],
		a038 =>
		['Save norm(E)',                     sub{save_chi('n')},              "any"],
		a041 =>
		['Save deriv(E)',                    sub{save_chi('d')},              "any"],
		a044 =>
		['Save chi(k)',                      sub{save_chi('k')},              "any"],
		a048 =>
		['Save chi(R)',                      sub{save_chi('R')},              "any"],
		a051 =>
		['Save chi(q)',                      sub{save_chi('q')},              "any"],
		a054 =>
		["Save marked groups as mu(E)",      sub{save_marked('e')},           "any"],
		a058 =>
		["Save marked groups as norm(E)",    sub{save_marked('n')},           "any"],
		a061 =>
		["Save marked groups as deriv(E)",   sub{save_marked('d')},           "any"],
		a064 =>
		["Save marked groups as chi(k)",     sub{save_marked('k')},           "any"],
		a068 =>
		["Save marked groups as |chi(R)|",   sub{save_marked('rm')},          "any"],
		a071 =>
		["Save marked groups as Re[chi(R)]", sub{save_marked('rr')},          "any"],
		a074 =>
		["Save marked groups as Im[chi(R)]", sub{save_marked('ri')},          "any"],
		a078 =>
		["Save marked groups as |chi(q)|",   sub{save_marked('qm')},          "any"],
		a081 =>
		["Save marked groups as Re[chi(q)]", sub{save_marked('qr')},          "any"],
		a084 =>
		["Save marked groups as Im[chi(q)]", sub{save_marked('qi')},          "any"],
		#a088 =>
		#["Close project",                    sub{reset_window($which_showing, $fat_showing)
		#					   unless ($fat_showing eq 'normal');
		#					 delete_many($list, $dmode, 0)}, "any", 'Ctrl-w'],
		a091 =>
		['Quit',                             \&quit_athena,                   "any", 'Ctrl-q'],
	       },
	       Edit =>
	       {
		a001 =>
		["Display Ifeffit buffer", sub{raise_palette('ifeffit'); $top->update;},                "any", 'Ctrl-1']  ,
		a004 =>
		["Show group's titles", sub{raise_palette('titles');  $top->update;},                   "any", 'Ctrl-2'],
		a008 =>
		["Edit data as text", \&setup_data,                                                     "any", 'Ctrl-3'],
		a011 =>
		["Show group's arrays", sub{Echo('No data!'), return unless ($current);
					    raise_palette('ifeffit');
					    return if ($current eq "Default Parameters");
					    $setup->dispose("show \@group $current\n", $dmode);
					    $top->update},                                            "any"],
		a014 =>
		["Show all strings", sub{raise_palette('ifeffit');
					 $setup->dispose("show \@strings\n", $dmode);
					 $top->update},                                               "any"],
		a018 =>
		["Show all macros",                       sub{raise_palette('ifeffit');
							      $setup->dispose("show \@macros\n", $dmode);
							      $top->update},                         "any"],
		a021 =>
		["Display echo buffer",                   sub{raise_palette('echo'); $top->update;},    "any", 'Ctrl-4'],
		a024 =>
		["Record a macro",                        sub{raise_palette('macro'); $top->update;},   "any", 'Ctrl-5'],
		a028 =>
		["Load a macro"				, \&load_macro,                          "any"],
		a031 =>
		["Write in project journal",              sub{raise_palette('journal'); $top->update;}, "any", 'Ctrl-6'],
		a034 =>
		["Write an Excel report (all groups)",    sub{&report_excel('all')},                    "any"],
		a038 =>
		["Write an Excel report (marked groups)", sub{&report_excel('marked')},                 "any"],
		a041 =>
		["Write a CSV report (all groups)",       sub{&report_csv('all')},                      "any"],
		a044 =>
		["Write a CSV report (marked groups)",    sub{&report_csv('marked')},                   "any"],
		a048 =>
		["Write an ascii report (all groups)",    sub{&report_ascii('all')},                    "any"],
		a051 =>
		["Write an ascii report (marked groups)", sub{&report_ascii('marked')},                 "any"],
	       },

	       Group =>
	       {
		a001 =>
		["Copy group",                   \&copy_group,                       "any", 'Ctrl-y'],
		a004 =>
		["Make detector groups",         \&make_detectors,                   "any"],
		a008 =>
		["Make background group",        \&make_background,                  "any"],
		a011 =>
		["Change group label",           \&get_new_name,                     "any", 'Ctrl-l'],
		a014 =>
		["Remove group",                 sub{delete_group($list, $dmode);},  "any"],
		a018 =>
		["Identify group's record type", \&identify_group,                   "any"],
		a021 =>
		["Move group up",                \&group_up,                         "any", 'Alt-k'],
		a024 =>
		["Move group down",              \&group_down,                       "any", 'Alt-j'],
		a028 =>
		["Remove marked groups",         sub{delete_many($list, $dmode, 1)}, "any"],
		a031 =>
		["Set all groups'  values to the current", sub{Echo('No data!'), return unless ($current);
							       Echo("Parameters for all groups reset to \`$current\'");
							       my $orig = $current;
							       foreach my $x (keys %marked) {
								 next if ($x eq 'Default Parameters');
								 next if ($x eq $current);
								 $groups{$x}->set_to_another($groups{$current});
								 set_properties(1, $x, 0);
							       }
							       ;
							       set_properties(1, $orig, 0);
							       Echo(@done);}, "any"],
		a034 =>
		["Set all marked groups'  values to the current", sub{Echo('No data!'), return unless ($current);
								      Echo("Parameters for all marked groups reset to \`$current\'");
								      my $orig = $current;
								      foreach my $x (keys %marked) {
									next if ($x eq 'Default Parameters');
									next if ($x eq $current);
									next unless ($marked{$x});
									$groups{$x}->set_to_another($groups{$current});
									set_properties(1, $x, 0);
								      }
								      ;
								      set_properties(1, $orig, 0);
								      Echo(@done);}, "any"],
		a038 =>
		["Set current groups'  values to their defaults", sub{Echo('No data!'), return unless ($current);
								      my @keys = grep {/^(bft|bkg|fft)/} (keys %widget);
								      set_params('def', @keys);
								      set_properties(1, $current, 0);
								      Echo("Reset all values for this group to their defaults");}, "any"],
		a041 =>
		["Reset E0 for this group",      sub{set_edge($current, 'edge')},   "any"],
		a044 =>
		["Set E0 to a set fraction of the edge step", sub{set_edge($current, 'fraction')},   "any"],
		a048 =>
		["Set E0 to atomic value",       sub{set_edge($current, 'atomic')}, "any"],
	       },

	       Plot =>
	       {
		a0001 =>
		['Prompt for space for plotting current group', sub{&dispatch_space('plot_current')}, "any"],
		a0005 =>
		['Prompt for space for plotting marked groups', sub{&dispatch_space('plot_marked')}, "any"],


		a001 =>
		['Plot merge+standard deviation', sub{my $group = $groups{$current}->{group};
						      my $space = $groups{$current}->{is_merge};
						      &plot_merge($group, $space);}, "any"],
		a004 =>
		['Plot chi(E)', sub{my $str = 'k' . $plot_features{k_w} . 'e';
				    $groups{$current}->plotk($str,$dmode,\%plot_features, \@indicator) }, "any"],
		a008 =>
		['Plot chi(E), marked', sub{my $str = $plot_features{k_w} . 'e';
					    $groups{$current}->plot_marked($str,$dmode,\%groups,
									   \%marked, \%plot_features,
									   $list, \@indicator) }, "any"],
		a011 =>
		['Zoom',                \&zoom,                 "any", 'Ctrl-='],
		a014 =>
		['Unzoom',              sub{&replot('replot')}, "any", 'Ctrl--'],
		a018 =>
		['Cursor',              \&cursor,               "any", 'Ctrl-.'],
		## save last plot as an image
		a021 =>
		['Print last plot',     sub{&replot('print')},  "any", 'Ctrl-p'],
		##a024 =>
		##['Detach plot buttons', \&detach_plot,          "any"],
	       },

	       Mark =>
	       {
		a001 =>
		['Mark all groups',          sub{mark('all')},     "any", 'Ctrl-a'],
		a004 =>
		['Invert marks',             sub{mark('toggle')},  "any", 'Ctrl-i'],
		a008 =>
		['Clear all marks',          sub{mark('none')},    "any", 'Ctrl-u'],
		a011 =>
		["Toggle this group's mark", sub{mark('this')},    "any", 'Ctrl-t'],
		a014 =>
		["Mark regex",               sub{mark('regex')},   "any", 'Ctrl-r'],
		a017 =>
		["Unmark regex",             sub{mark('unregex')}, "any"],
	       },

	       Data =>
	       {
		a011 =>
		["Open calibration dialog", \&calibrate, "normal"],
		a012 =>
		{"Calibrate" =>{
				a010 =>
				['Select a point', sub{$widget{calib_select}   ->invoke()}, "calibration"],
				a020 =>
				['Replot', sub{$widget{calib_replot}   ->invoke()}, "calibration"],
				a030 =>
				['Calibrate', sub{$widget{calib_calibrate}->invoke()}, "calibration"],
			       },
		},
		a031 =>
		['Open deglitching dialog', \&deglitch_palette, "normal"],
		a032 =>
		{"Deglitch" =>{
			       a010 =>
			       ["Choose a point", sub{$widget{deg_single}->invoke()}, "deglitching"],
			       a020 =>
			       ["Remove a point", sub{$widget{deg_point} ->invoke()}, "deglitching"],
			       a030 =>
			       ["Replot", sub{$widget{deg_replot}->invoke()}, "deglitch"],
			       a040 =>
			       ["Remove glitches", sub{$widget{deg_remove}->invoke()}, "deglitching"],
			      },
		},
		a051 =>
		['Open truncation dialog', \&truncate_palette, "normal"],
		a052 =>
		{"Truncate" =>{
			       a010 =>
			       ["Replot", sub{$widget{trun_replot}  ->invoke()}, "truncation"],
			       a020 =>
			       ["Truncate", sub{$widget{trun_truncate}->invoke()}, "truncation"],
			      },
		},
		a071 =>
		['Open smoothing dialog', \&smooth, "normal"],
		a072 =>
		{"Smooth" =>{
			     a010 =>
			     ["Choose iterative smoothing", sub{$widget{sm_it_button}->invoke()}, "smoothing"],
			     a020 =>
			     ["Choose Fourier filter smoothing", sub{$widget{sm_ff_button}->invoke()}, "smoothing"],
			     a030 =>
			     ["Plot data and smoothed spectrum", sub{$widget{sm_plot}->invoke()}, "smoothing"],
			     a040 =>
			     ["Put smoothed data into a group", sub{$widget{sm_save}->invoke()}, "smoothing"],
			    },
		},
		a900 =>
		['How many spline knots?', \&nknots, "any"],
	       },

	       Align =>
	       {
		a011 =>
		['Align scans', sub{&align_two($config{align}{align_default})}, "normal"],
		a012 =>
		{"Align" =>{
			    a010 =>
			    ["Auto align",    sub{$widget{align_auto}      ->invoke()}, "alignment"],
			    a020 =>
			    ["Replot",        sub{$widget{align_replot}    ->invoke()}, "alignment"],
			    a030 =>
			    ["plus 5",        sub{$widget{align_plus5}     ->invoke()}, "alignment"],
			    a040 =>
			    ["minus 5",       sub{$widget{align_minus5}    ->invoke()}, "alignment"],
			    a050 =>
			    ["plus 1",        sub{$widget{align_plus1}     ->invoke()}, "alignment"],
			    a060 =>
			    ["minus 1",       sub{$widget{align_minus1}    ->invoke()}, "alignment"],
			    a070 =>
			    ["plus 1/2",      sub{$widget{'align_plus0.5'} ->invoke()}, "alignment"],
			    a080 =>
			    ["minus 1/2",     sub{$widget{'align_minus0.1'}->invoke()}, "alignment"],
			    a090 =>
			    ["plus 1/10",     sub{$widget{'align_plu0.1'}  ->invoke()}, "alignment"],
			    a100 =>
			    ["minus 1/10",    sub{$widget{'align_minus0.1'}->invoke()}, "alignment"],
			    a110 =>
			    ["Restore value", sub{$widget{align_restore}   ->invoke()}, "alignment"],
			   }
		},
		a071 =>
		["Calibrate dispersive XAS", \&pixel, "normal"],
		a072 =>
		{"Dispersive XAS" => {
				      a010 =>
				      ["Refine alignment parameters",     sub{$widget{pixel_refine}	 ->invoke()}, "pixel"],
				      a020 =>
				      ["Toggle constraint button",        sub{$widget{pixel_constrain}	 ->invoke()}, "pixel"],
				      a030 =>
				      ["Reset offset",                    sub{$widget{pixel_linear_button} ->invoke()}, "pixel"],
				      a040 =>
				      ["Replot standard and pixel data",  sub{$widget{pixel_replot}	 ->invoke()}, "pixel"],
				      a050 =>
				      ["Make data group",                 sub{$widget{pixel_make}		 ->invoke()}, "pixel"],
				      a060 =>
				      ["Convert all marked pixel groups", sub{$widget{pixel_all}		 ->invoke()}, "pixel"],
				     },
		},
	       },

	       Merge =>
	       {
		a001 =>
		['Prompt for merge space', sub{&dispatch_space('merge')}, "normal"],
		a005 =>
		['Merge marked data in chi(k)',  sub{&merge_groups('k')}, "normal"],
		a010 =>
		['Merge marked data in norm(E)', sub{&merge_groups('n')}, "normal"],
		a015 =>
		['Merge marked data in mu(E)',   sub{&merge_groups('e')}, "normal"],
		a020 =>
		['Merge marked data in chi(R)',  sub{&merge_groups('r')}, "normal"],
		a025 =>
		['Merge marked data in chi(q)',  sub{&merge_groups('q')}, "normal"],
	       },

	       Diff =>
	       {
		a001 =>
		['Prompt for difference spectrum space', sub{&dispatch_space('difference')}, "normal"],
		a005 =>
		['Open difference spectra dialog: norm(E)', sub{&difference('n')}, "normal"],
		a010 =>
		['Open difference spectra dialog: chi(k)',  sub{&difference('k')}, "normal"],
		a015 =>
		['Open difference spectra dialog: mu(E)',   sub{&difference('e')}, "normal"],
		a020 =>
		['Open difference spectra dialog: chi(R)',  sub{&difference('r')}, "normal"],
		a025 =>
		['Open difference spectra dialog: chi(q)',  sub{&difference('q')}, "normal"],
		a030 =>
		{"Difference Spectra" => {
					  a010 =>
					  ["Integrate",				     sub{$widget{diff_integrate}->invoke()},   "difference spectrum"],
					  a020 =>
					  ["Replot",					     sub{$widget{diff_replot}->invoke()},      "difference spectrum"],
					  a030 =>
					  ["Make difference group",			     sub{$widget{diff_save}->invoke()},        "difference spectrum"],
					  a040 =>
					  ["Make difference groups from all marked groups", sub{$widget{diff_savemarked}->invoke()},  "difference spectrum"],
					  a050 =>
					  ["Toggle Integrate? button",			     sub{$widget{diff_savemarkedi}->invoke()}, "difference spectrum"],
					 },
		},
	       },

	       Analysis =>
	       {
		a021 =>
		['Open log-ratio dialog', \&log_ratio, "normal"],
		a022 =>
		{"Log-Ratio" => {
				 a010 =>
				 ["Fit",		    sub{$widget{lr_fit}  ->invoke()}, "log ratio"],
				 a020 =>
				 ["Plot log-ratio",	    sub{$widget{lr_lr}   ->invoke()}, "log ratio"],
				 a030 =>
				 ["Plot phase difference", sub{$widget{lr_pd}   ->invoke()}, "log ratio"],
				 a040 =>
				 ["Save ratio data",	    sub{$widget{lr_save} ->invoke()}, "log ratio"],
				 a050 =>
				 ["Write log file",	    sub{$widget{lr_log}  ->invoke()}, "log ratio"],
				 a060 =>
				 ["Plot in k",		    sub{$widget{lr_plotk}->invoke()}, "log ratio"],
				 a070 =>
				 ["Plot in R",		    sub{$widget{lr_plotr}->invoke()}, "log ratio"],
				 a080 =>
				 ["Plot in q",		    sub{$widget{lr_plotq}->invoke()}, "log ratio"],
				},
		},
		a041 =>
		['Open peak fitting dialog', \&peak_fit,  "normal"],
		a042 =>
		{"Peak fit" => {
				a010 =>
				["Toggle components button",		   sub{$widget{peak_components}->invoke()}, "peak fitting"],
				a020 =>
				["Toggle centroids button",		   sub{$widget{peak_show}      ->invoke()}, "peak fitting"],
				a030 =>
				["Fit and plot",			   sub{$widget{peak_fit}       ->invoke()}, "peak fitting"],
				a040 =>
				["Reset amplitudes and widths",	   sub{$widget{peak_reset}     ->invoke()}, "peak fitting"],
				a050 =>
				["Save best fit function as a data group",sub{$widget{peak_save}      ->invoke()}, "peak fitting"],
				a060 =>
				["Write a log file",			   sub{$widget{peak_log}       ->invoke()}, "peak fitting"],
			       },
		},

		a051 =>
		['Open linear combination fitting dialog', \&lcf, "normal"],
		a052 =>
		{"Linear combination fit" => {
					      a010 =>
					      ["Fit", sub{$widget{lcf_fit}->invoke()}, "linear combination fitting"],
					      a020 =>
					      ["Plot data and fit", sub{$widget{lcf_plot}->invoke()}, "linear combination fitting"],
					      a030 =>
					      ["Write a report", sub{$widget{lcf_report}->invoke()}, "linear combination fitting"],
					      a040 =>
					      ["Save fit as a group", sub{$widget{lcf_group}->invoke()}, "linear combination fitting"],
					      a050 =>
					      ["Reset", sub{$widget{lcf_reset}->invoke()}, "linear combination fitting"],
					      a060 =>
					      ["Toggle linear background", sub{$widget{lcf_linear}->invoke()}, "linear combination fitting"],
					     },
		},
	       },

	       ## Add key binding data for your new analysis chore
	       ## here

	       # a091 =>
	       # ['Open foobarication dialog', \&foobaricate,  "normal"],
	       # a092 =>
	       # {"Foobaricate" =>
	       #	{
	       #	 a005 => ["Do one thing",     \&sub_ref1, "demo"],
	       #	 a010 => ["Do another thing", \&sub_ref2, "demo"],
	       #	},
	       # },

	       Settings =>
	       {
		a005 =>
		['Swap panels',	      \&swap_panels,     "any", 'Ctrl-/'],
		a010 =>
		["Purge web download cache", \&purge_web_cache, "any"],
		a031 =>
		["Edit preferences",	      \&prefs,           "normal"],
		a032 =>
		{Preferences => {
				 a010 =>
				 ["Save all parameters to Athena's defaults", sub{$widget{prefs_all}    ->invoke()}, "preferences"],
				 a020 =>
				 ["Apply changes to this session",	       sub{$widget{prefs_apply}  ->invoke()}, "preferences"],
				 a030 =>
				 ["Save changes for future sessions",	       sub{$widget{prefs_future} ->invoke()}, "preferences"],
				},
		},
	       },

	       Help =>
	       {
		a010 =>
		['Document', sub{pod_display("index.pod")}, "any", 'Ctrl-m'],
		a020 =>
		['Import a demo projects', \&read_demo, "normal"],
		a030 =>
		['Show a hint', \&show_hint, "any", 'Ctrl-h'],
		a040 =>
		['About Ifeffit', sub{Echo("Using Ifeffit ". Ifeffit::get_string("\$&build"))}, "any"],
		a050 =>
		['About Athena', sub{Echo($About)}, "any"],
		a060 =>
		["Check Ifeffit's memory usage", sub{$groups{"Default Parameters"} -> memory_check($top, \&Echo, \%groups, $max_heap, 1, 0)}, "any"],
	       },
	      );
  ##   open FOO, ">foo";
  ##   $Data::Dumper::Indent = 2;
  ##   $Data::Dumper::Deparse=1;
  ##   print FOO Data::Dumper->Dump([\%key_data], [qw(*key_data)]);
  ##   $Data::Dumper::Indent = 0;
  ##   close FOO;
};


sub key_bindings {
  my %keys_params = ();
  $keys_params{save} = 0;
  $keys_params{modifier} = 'control';
  $keys_params{modifier_label} = "Ctrl-$config{general}{user_key}";
  $fat_showing = 'keys';
  $hash_pointer = \%keys_params;
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat -> packForget;
  my $keys = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$keys -> packPropagate(0);
  $which_showing = $keys;
  $keys -> Label(-text=>"Edit Key Bindings",
		 -font=>$config{fonts}{large},
		 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');


  $keys -> Button(-text=>'Return to the main window',  @button_list,
		   -background=>$config{colors}{background2},
		   -activebackground=>$config{colors}{activebackground2},
		   -command=>sub{
		     if ($keys_params{save}) {
		       my $message = "Do you want to save your key bindings for future sessions?";
		       my $dialog =
			 $top -> Dialog(-bitmap         => 'questhead',
					-text           => $message,
					-title          => 'Athena: save key bindings?',
					-buttons        => ['Yes', 'No'],
					-default_button => 'Yes',);
		       my $response = $dialog->Show();
		       &keys_save if ($response eq 'Yes');
		     };
		     &reset_window($keys, "key bindings", 0)}
		  )
    -> pack(-side=>'bottom', -fill=>'x');
  $keys -> Button(-text=>'Document section: key bindings', @button_list,
		  -command=>sub{pod_display("ui::keys.pod")},)
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);



  my $labframe = $keys -> LabFrame(-label=>'All functions',
				    -labelside=>'acrosstop')
    -> pack(-side=>'top', -expand=>1, -fill=>'both');
  my $tree;
  $tree = $labframe -> Scrolled('Tree',
				-scrollbars => 'se',
				-width      => 45,
				-background => $config{colors}{hlist},
				-browsecmd  => sub{&keys_browse($tree, \%keys_params)}
			       )
    -> pack(-expand=>1, -fill=>'both');
  $tree->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					    ($is_windows) ? () : (-width=>8));
  $tree->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					    ($is_windows) ? () : (-width=>8));

  my $frame = $keys -> Frame(-relief=>'flat')
    -> pack(-side=>'top');

  $frame -> Label(-text=>'Category:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e', -columnspan=>3);
  $frame -> Label(-text=>' ', -width=>35, -justify=>'left',
		  -textvariable=>\$keys_params{category})
    -> grid(-row=>0, -column=>3, -sticky=>'e', -columnspan=>2);
  $frame -> Label(-text=>'Valid when showing:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e', -columnspan=>3);
  $frame -> Label(-text=>' ', -width=>35, -justify=>'left',
		  -textvariable=>\$keys_params{valid})
    -> grid(-row=>1, -column=>3, -sticky=>'e', -columnspan=>2);
  $frame -> Label(-text=>'Description:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e', -columnspan=>3);
  $frame -> Label(-text=>' ', -width=>35, -justify=>'left',
		  -textvariable=>\$keys_params{descr})
    -> grid(-row=>2, -column=>3, -sticky=>'e', -columnspan=>2);
  $frame -> Label(-text=>'Bound to:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e', -columnspan=>3);
  $frame -> Label(-text=>' ', -width=>35, -justify=>'left',
		  -textvariable=>\$keys_params{bound})
    -> grid(-row=>3, -column=>3, -sticky=>'e', -columnspan=>2);

  $frame -> Label(-text=>'Key:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $widget{keys_modifier} = $frame -> Optionmenu(-font=>$config{fonts}{small},
						-textvariable => \$keys_params{modifier_label},
						-width=>12,
						-borderwidth=>1,
						-state=>'disabled')
    -> grid(-row=>4, -column=>1);
  foreach my $i ("Ctrl-$config{general}{user_key}", "Alt-$config{general}{user_key}") {
    $widget{keys_modifier} -> command(-label => $i,
				      -command=>sub{
					$keys_params{modifier_label} = $i;
					$keys_params{modifier} = ($i =~ /^Ctrl/) ? 'control' : 'meta';
				      })
  };

  $widget{keys_key} = $frame -> KeyEntry(-width	  => 3,
					 -justify => 'center',
					 -font	  => $config{fonts}{fixed}
					 -state	  => 'disabled',)
    -> grid(-row=>4, -column=>2, -sticky=>'w');
  $widget{keys_bindit} = $frame
    -> Button(-text=>"Bind it!", @button_list,
	      -state => 'disabled',
	      -command=>sub{&keys_bind($tree, \%keys_params)})
    -> grid(-row=>4, -column=>3, -sticky=>'e', -padx=>2);
  $widget{keys_unbind} = $frame
    -> Button(-text=>"Unbind", @button_list,
	      -state => 'disabled',
	      -command=>sub{&keys_unbind($tree, \%keys_params)})
    -> grid(-row=>4, -column=>4, -sticky=>'w', -padx=>2);

  $frame -> Button(-text=>"Show all bindings",  @button_list,
		   -command=>\&keys_show_all)
    -> grid(-row=>5, -column=>0, -columnspan=>5, -sticky=>'ew');
  #$frame -> Button(-text=>"Apply key bindings to current session",  @button_list,
  #		   -command=>[\&Echo, "Apply."])
  #  -> grid(-row=>6, -column=>0, -columnspan=>4, -sticky=>'ew');
  $widget{keys_save} = $frame
    -> Button(-text=>"Save key bindings for future sessions",  @button_list,
	      -command=>\&keys_save,
	      -state=>'disabled')
    -> grid(-row=>7, -column=>0, -columnspan=>5, -sticky=>'ew');
  $frame -> Button(-text=>"Clear all key bindings",  @button_list,
		   -command=>\&keys_clear)
    -> grid(-row=>8, -column=>0, -columnspan=>5, -sticky=>'ew');

  &keys_fill_tree($tree, \%keys_params);
};


## the way the tree paths are chosen, infoAnchor can be split on the
## dots to yield the hash keys that get to the commands in %key_data
sub keys_fill_tree {
  my $tree = $_[0];
  foreach my $p (qw(File Edit Group Plot Mark Data Align Merge Diff
		    Analysis Settings Help)) {
    $tree -> add($p, -text=>$p, -data=>'category');
    foreach my $first (sort keys %{$key_data{$p}}) {
      if (ref($key_data{$p}->{$first}) eq 'ARRAY') {
	## these are commands in the menubar menus
	## $this is a concatination of the hash keys needed to get to
	## this command
	my $this = join(".", $p, $first);
	$tree -> add($this,
		     -text=>$key_data{$p}->{$first}->[0],
		     -data=>$key_data{$p}->{$first});
	$tree -> setmode($this, 'none');
      } elsif (ref($key_data{$p}->{$first}) eq 'HASH') {
	## these are commands on the various data processing views
	foreach my $second (sort keys %{$key_data{$p}->{$first}}) {
	  my $this = join(".", $p, $first);
	  $tree -> add($this, -text=>$second, -data=>'category');
	  foreach my $third (sort keys %{$key_data{$p}->{$first}->{$second}}) {
	    ## $child is a concatination of the hash keys needed to
	    ## get to this command
	    my $child = join(".", $p, $first, $third);
	    $tree -> add($child,
			 -text=>$key_data{$p}->{$first}->{$second}->{$third}->[0],
			 -data=>$key_data{$p}->{$first}->{$second}->{$third});
	    $tree -> setmode($child, 'none');
	  };
	  $tree -> setmode($this, 'close');
	  $tree -> close($this);
	};
      };
    };
    $tree -> setmode($p, 'close');
    $tree -> close($p);
  };
  $tree->autosetmode();
};

sub keys_browse {
  my ($tree, $rhash) = @_;
  my $this = $tree->infoAnchor;
  $widget{keys_key} -> delete(0, 'end');
  unless ($this) {		# clicking on [+] button
    $$rhash{category} = "";
    $$rhash{descr}    = "";
    $$rhash{function} = "";
    $$rhash{valid}    = "";
    $$rhash{bound}    = "";
    map { $widget{'keys_'.$_} -> configure(-state=>'disabled') } (qw(bindit unbind key modifier));
    return;
  };
  my $data = $tree->infoData($this);

  if (ref($data) eq 'ARRAY') {	# this is a command
    my @list = split(/\./, $this);
    if ($#list == 1) {
      $$rhash{category} = $list[0];
    } else {
      ## the ugly thing at the end of the next line is to pull the
      ## name of the sub-branch out of the %key_data data structure
      $$rhash{category} = $list[0] . ' -> ' . (keys %{$key_data{$list[0]}->{$list[1]}})[0];
    };
    $$rhash{descr}    = $$data[0];
    $$rhash{function} = $$data[1];
    $$rhash{valid}    = $$data[2] . " view";
    $$rhash{bound}    = $$data[3] || "";
    foreach my $k (keys %{$config{controlkeys}}) {
      if ($config{controlkeys}{$k} eq $this) {
	if ($$rhash{bound}) {
	  $$rhash{bound} .= "    Ctrl-$config{general}{user_key} $k";
	} else {
	  $$rhash{bound}  = "Ctrl-$config{general}{user_key} $k";
	};
      };
    };
    foreach my $k (keys %{$config{metakeys}}) {
      if ($config{metakeys}{$k} eq $this) {
	if ($$rhash{bound}) {
	  $$rhash{bound} .= "    Alt-$config{general}{user_key} $k";
	} else {
	  $$rhash{bound}  = "Alt-$config{general}{user_key} $k";
	};
      };
    };
    map { $widget{'keys_'.$_} -> configure(-state=>'normal') } (qw(bindit unbind key modifier));

  } else {			# category header
    $$rhash{category} = (split(/\./, $this))[0];
    $$rhash{descr}    = "";
    $$rhash{function} = "";
    $$rhash{valid}    = "";
    $$rhash{bound}    = "";
    map { $widget{'keys_'.$_} -> configure(-state=>'disabled') } (qw(bindit unbind key modifier));
  };
};


sub keys_bind {
  my ($tree, $rhash) = @_;
  my $key  = $widget{keys_key} -> get();
  return if ($key =~ /^\s+$/);
  my $modifier = $$rhash{modifier};
  my $mod = substr(uc($modifier), 0, 1);
  my $val  = $tree -> infoAnchor;
  $config{$modifier.'keys'}{$key} = $val;
  $widget{keys_save} -> configure(-state=>'normal');
  $$rhash{save} = 1;
  $tree -> KeyboardBrowse;
  $widget{keys_key} -> insert('end', $key);
  Echo("Bound $mod, - $key to \"$$rhash{descr}\"");
};


sub keys_unbind {
  my ($tree, $rhash) = @_;
  my $key  = $widget{keys_key} -> get();
  return if ($key =~ /^\s*$/);
  my $modifier = $$rhash{modifier};
  Error("$modifier-, $key is not bound to a function"), return unless exists $config{$modifier.'keys'}{$key};
  delete $config{$modifier.'keys'}{$key};
  $widget{keys_save} -> configure(-state=>'normal');
  $$rhash{save} = 1;
  $tree -> KeyboardBrowse;
  $widget{keys_key} -> insert('end', $key);
  my $mod = ($modifier eq 'control') ? "C" : "A";
  Echo("Removed binding to $mod-, $key");
};

sub keys_clear {
  foreach my $k (keys %{$config{controlkeys}}) {
    delete $config{controlkeys}{$k};
  };
  foreach my $k (keys %{$config{metakeys}}) {
    delete $config{metakeys}{$k};
  };
  Echo("Erase all bound keys for the current session.");
};


sub keys_show_all {
  my $message = "The following key sequences have been bound:\n\n";
  my $count = 0;
  foreach my $k (sort keys %{$config{controlkeys}}) {
    my @list = split(/\./, $config{controlkeys}{$k});
    my $category;
    if ($#list == 1) {
      $category = join(' -> ', $list[0], $key_data{$list[0]}->{$list[1]}->[0]);
    } else {
      ## the ugly thing at the end of the next line is to pull the
      ## name of the sub-branch out of the %key_data data structure
      my $branch = (keys %{$key_data{$list[0]}->{$list[1]}})[0];
      $category = join(' -> ', $list[0],
		       (keys %{$key_data{$list[0]}->{$list[1]}})[0],
		       $key_data{$list[0]}->{$list[1]}->{$branch}->{$list[2]}->[0]
		      );

    };
    $message .= "  C $config{general}{user_key} - $k:\t$category\n";
    ++$count;
  };
  foreach my $k (sort keys %{$config{metakeys}}) {
    my @list = split(/\./, $config{metakeys}{$k});
    my $category;
    if ($#list == 1) {
      $category = join(' -> ', $list[0], $key_data{$list[0]}->{$list[1]}->[0]);
    } else {
      ## the ugly thing at the end of the next line is to pull the
      ## name of the sub-branch out of the %key_data data structure
      my $branch = (keys %{$key_data{$list[0]}->{$list[1]}})[0];
      $category = join(' -> ', $list[0],
		       (keys %{$key_data{$list[0]}->{$list[1]}})[0],
		       $key_data{$list[0]}->{$list[1]}->{$branch}->{$list[2]}->[0]
		      );

    };
    $message .= "  A $config{general}{user_key} - $k:\t$category\n";
    ++$count;
  };
  ($message = "There currently are no defined key bindings.") unless $count;
  my $dialog =
    $top -> Dialog(-bitmap         => 'info',
		   -text           => $message,
		   -title          => 'Athena: key bindings',
		   -buttons        => ['OK'],
		   -default_button => 'OK',);
  my $response = $dialog->Show();
};


sub keys_save {
  my $rhash = $_[0];
  rename $personal_rcfile, $personal_rcfile.".bak";
  my $config_ref = tied %config;
  $config_ref -> WriteConfig($personal_rcfile);
  $$rhash{save} = 0;
  $widget{keys_save} -> configure(-state=>'disabled');
  Echo("Saved key bindings to \"$personal_rcfile\"");
};


sub keys_dispatch {
  my $modifier = $_[1];
  #print join(" ", @_), $/;
  my $mod = ($modifier eq 'control') ? "C" : "A";
  my $who = $top->focusCurrent;
  $multikey = "";
  Echonow("$mod-$config{general}{user_key} - <<waiting for end of key sequence...>>");
  $echo -> focus();
  $echo -> grab;
  $echo -> waitVariable(\$multikey);
  $echo -> grabRelease;
  $who -> focus;

  ##   my %nonalphanumerics = (period=>'.',
  ## 			  comma=>',',
  ## 			  bracketleft=>'[',
  ## 			  bracketright=>']',
  ## 			  semicolon=>';',
  ## 			  colon=>':',
  ## 			  equal=>'=',
  ## 			  plus=>'+',
  ## 			  minus=>'-',
  ## 			  slash=>'/',
  ## 			  apostrophe=>"\'",
  ## 			  backslash=>"\\",
  ## 			  grave=>'`',
  ## 			  space=>' ',
  ## 			 );
  ##   ($multikey = $nonalphanumerics{$multikey}) if exists $nonalphanumerics{$multikey};
  Error("$mod-, - $multikey   is not bound to a command"), return unless (exists $config{$modifier.'keys'}{$multikey});

  ## need to translate $multikey for the non-alphanumerics
  my @id = split(/\./, $config{$modifier.'keys'}{$multikey});
  my ($description, $function, $view);
  if ($#id == 1) {
    $description = $key_data{$id[0]}->{$id[1]}->[0];
    $function    = $key_data{$id[0]}->{$id[1]}->[1];
    $view        = $key_data{$id[0]}->{$id[1]}->[2];
  } else {
    my $branch = (keys %{$key_data{$id[0]}->{$id[1]}})[0];
    $description = $key_data{$id[0]}->{$id[1]}->{$branch}->{$id[2]}->[0];
    $function    = $key_data{$id[0]}->{$id[1]}->{$branch}->{$id[2]}->[1];
    $view        = $key_data{$id[0]}->{$id[1]}->{$branch}->{$id[2]}->[2];
  };

  ## check to make sure that this function can be called at this time.
 CHECKVIEW: {
    ($view eq "normal")and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the normal view"),
	return unless ($fat_showing eq "normal");
      last CHECKVIEW;
    };
    ($view eq "calibration") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the calibration view"),
	return unless ($fat_showing eq 'calibrate');
      last CHECKVIEW;
    };
    ($view eq "deglitching") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the deglitching view"),
	return unless ($fat_showing eq 'deglitch');
      last CHECKVIEW;
    };
    ($view eq "truncation") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the truncation view"),
	return unless ($fat_showing eq 'truncate');
      last CHECKVIEW;
    };
    ($view eq "smoothing") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the smoothing view"),
	return unless ($fat_showing eq 'smooth');
      last CHECKVIEW;
    };
    ($view eq "alignment") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the alignment view"),
	return unless ($fat_showing eq 'align');
      last CHECKVIEW;
    };
    ($view eq "difference spectrum") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the difference spectrum view"),
	return unless ($fat_showing eq 'diff');
      last CHECKVIEW;
    };
    ($view eq "log ratio") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the log ratio view"),
	return unless ($fat_showing eq 'lograt');
      last CHECKVIEW;
    };
    ($view eq "peak fitting") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the peak fitting view"),
	return unless ($fat_showing eq 'peakfit');
      last CHECKVIEW;
    };
    ($view eq "preferences") and do {
      Echo("$mod-, - $multikey aborted!  \"$description\" can only be called in the preferences view"),
	return unless ($fat_showing eq 'prefs');
      last CHECKVIEW;
    };
  };
  Echonow("$mod-, - $multikey    ( $description )");
  &$function;
};


## this is a generalized multiplexer for dispatching functions
## according to a space obtained from the keyboard.  for example, one
## might bind "C-, m" to this function for prompting for a mergeing
## space.  then the key chain "C-, m e" would merge the marked data in
## mu(E)
sub dispatch_space {
  my $function = $_[0];
  my $space;

  ## for merging and difference spectra, spaces are e=energy,
  ## n=normalize, k=chi(k), r=chi(R), q=chi(q)
  my $spaces = "enkrq";
  ## saving current group also has d=derivative
  ($spaces = "endkrq") if ($function eq 'save');
  ## plotting, dispatch these to the appropriate plotting functions
  if ($function =~ /^plot/) {
    &keyboard_plot       if ($function eq 'plot_current');
    keyboard_plot_marked if ($function eq 'plot_marked');
    return;
  };

  ## reuse the trick of giving the echo area the focus and capturing
  ## the next keystroke
  my $who = $top->focusCurrent;
  $multikey = "";
  Echonow(ucfirst($function) . " in which space? [$spaces]");
  $echo -> focus();
  $echo -> grab;
  $echo -> waitVariable(\$multikey);
  $echo -> grabRelease;
  $who  -> focus;

  Error("\"$multikey\" is not a $function space!"), return unless ($multikey =~ /[$spaces]/);
 FUNCTION: {
    &merge_groups($multikey), last FUNCTION if ($function eq 'merge');
    &difference($multikey),   last FUNCTION if ($function eq 'difference');
    &save_chi($multikey),     last FUNCTION if ($function eq 'save');
  };
};

##   my $message = "";
##   ($message = "Merge data in ...") if ($function eq 'merge');
##   ($message = "Make difference spectra in ...") if ($function eq 'diff');
##   my $hint ="\n\nm n k r & q are keyboard shortcuts for the buttons below";
##   my $dialog =
##     $top -> Dialog(-bitmap         => 'question',
## 		   -text           => $message.$hint,
## 		   -title          => 'Athena: choose space',
## 		   -buttons        => [qw/mu(E) norm(E) chi(k) chi(R) chi(q) cancel/],);
##   $dialog -> bind('<Key-m>' =>
## 		  sub{ (($dialog->children())[1]->children)[1] -> invoke });
##   $dialog -> bind('<Key-n>' =>
## 		  sub{ (($dialog->children())[1]->children)[2] -> invoke });
##   $dialog -> bind('<Key-k>' =>
## 		  sub{ (($dialog->children())[1]->children)[3] -> invoke });
##   $dialog -> bind('<Key-r>' =>
## 		  sub{ (($dialog->children())[1]->children)[4] -> invoke });
##   $dialog -> bind('<Key-q>' =>
## 		  sub{ (($dialog->children())[1]->children)[5] -> invoke });
##   my $response = $dialog->Show();
##   Echo("Aborted!"), return if ($response eq 'cancel');
##   ($space = 'm') if ($response eq 'mu(E)');
##   ($space = 'n') if ($response eq 'norm(E)');
##   ($space = 'k') if ($response eq 'chi(k)');
##   ($space = 'r') if ($response eq 'chi(R)');
##   ($space = 'q') if ($response eq 'chi(q)');
##   $message =~ s/\.\.\./$response/;
##   Echonow($message);



## END OF KEY BINDINGS SUBSECTION
##########################################################################################

## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This file contains the fourier transform teaching dialog



sub teach_ft {

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters
  my %tft_params = (r1	  => 2,
		    r2	  => 3,
		    r3	  => 0,
		    ext   => 20,
		    npts  => 400,
		    kmin  => 2,
		    kmax  => 18,
		    rmin  => 1.75,
		    rmax  => 2.25,
		    dk	  => 2,
		    dr	  => 0.5,
		    kwin  => "Kaiser-Bessel",
		    rwin  => "Kaiser-Bessel",
		    plot  => 0,
		   );

  ## these two global variables must be set before this view is displayed
  $fat_showing = 'teach_ft';
  $hash_pointer = \%tft_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $tft = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$conv -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $tft;

  ## the standard label along the top identifying this analysis chore
  $tft -> Label(-text=>"Understanding Fourier transforms",
		-font=>$config{fonts}{large},
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');


  my @lab = (-foreground=>$config{colors}{activehighlightcolor});
  my $fr = $tft -> Frame(-relief=>'sunken', -borderwidth=>2)
    -> pack(-side=>'top', -fill=>'x',  -anchor=>'w', -padx=>2, -pady=>2, -ipady=>8);
  my $row = 0;

  $fr -> Label(-text=>'Wave #1', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_r1} = $fr -> Entry(-width=>5,
				 -validate=>'key',
				 -validatecommand=>[\&set_variable, 'tft_r1'],
				 -textvariable=>\$tft_params{r1},
				)
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'Angstroms', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'w');

  ++$row;
  $fr -> Label(-text=>'Wave #2', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_r2} = $fr -> Entry(-width=>5,
				 -validate=>'key',
				 -validatecommand=>[\&set_variable, 'tft_r2'],
				 -textvariable=>\$tft_params{r2},
				)
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'Angstroms', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'w');

  ++$row;
  $fr -> Label(-text=>'Wave #3', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_r3} = $fr -> Entry(-width=>5,
				 -validate=>'key',
				 -validatecommand=>[\&set_variable, 'tft_r3'],
				 -textvariable=>\$tft_params{r3},
				)
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'Angstroms', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'w');

  ++$row;
  $fr -> Label(-text=>'k extent', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_ext} = $fr -> Entry(-width=>5,
				  -validate=>'key',
				  -validatecommand=>[\&set_variable, 'tft_ext'],
				  -textvariable=>\$tft_params{ext},
				  )
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'Angstroms', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'w');


  ++$row;
  $fr -> Label(-text=>'kmin', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_kmin} = $fr -> Entry(-width=>5,
				   -validate=>'key',
				   -validatecommand=>[\&set_variable, 'tft_kmin'],
				   -textvariable=>\$tft_params{kmin},
				  )
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'kmax', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'e');
  $widget{tft_kmax} = $fr -> Entry(-width=>5,
				   -validate=>'key',
				   -validatecommand=>[\&set_variable, 'tft_kmax'],
				   -textvariable=>\$tft_params{kmax},
				  )
    -> grid(-row=>$row, -column=>3, -sticky=>'w');


  ++$row;
  $fr -> Label(-text=>'dk', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_dk} = $fr -> Entry(-width=>5,
				 -validate=>'key',
				 -validatecommand=>[\&set_variable, 'tft_dk'],
				 -textvariable=>\$tft_params{dk},
				)
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'k window', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'e');
  $fr -> Optionmenu(-options=>[qw(Kaiser-Bessel Hanning Parzen Welch)],
		    -variable=>\$tft_params{kwin},)
    -> grid(-row=>$row, -column=>3, -sticky=>'w');

  ++$row;
  $fr -> Label(-text=>'Rmin', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_rmin} = $fr -> Entry(-width=>5,
				   -validate=>'key',
				   -validatecommand=>[\&set_variable, 'tft_rmin'],
				   -textvariable=>\$tft_params{rmin},
				  )
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'Rmax', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'e');
  $widget{tft_rmax} = $fr -> Entry(-width=>5,
				   -validate=>'key',
				   -validatecommand=>[\&set_variable, 'tft_rmax'],
				   -textvariable=>\$tft_params{rmax},
				  )
    -> grid(-row=>$row, -column=>3, -sticky=>'w');

  ++$row;
  $fr -> Label(-text=>'dR', @lab)
    -> grid(-row=>$row, -column=>0, -sticky=>'e');
  $widget{tft_dr} = $fr -> Entry(-width=>5,
				 -validate=>'key',
				 -validatecommand=>[\&set_variable, 'tft_dr'],
				 -textvariable=>\$tft_params{dr},
				)
    -> grid(-row=>$row, -column=>1, -sticky=>'w');
  $fr -> Label(-text=>'R window', @lab)
    -> grid(-row=>$row, -column=>2, -sticky=>'e');
  $fr -> Optionmenu(-options=>[qw(Kaiser-Bessel Hanning Parzen Welch)],
		    -variable=>\$tft_params{rwin},)
    -> grid(-row=>$row, -column=>3, -sticky=>'w');


  my $red = $config{colors}{single};
  ++$row;
  $fr -> Radiobutton(-text        =>"Plot waves in k",
		     -variable    =>\$tft_params{plot},
		     -selectcolor =>$red,
		     -value       =>0,
		     -command     => sub{tft_plot_waves(\%tft_params)})
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');

  ++$row;
  $fr -> Radiobutton(-text	  => "Plot sum*window in k", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 1,
		     -command	  => sub{tft_plot_windowed(\%tft_params)},)
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');

  ++$row;
  $fr -> Radiobutton(-text=>"Plot magnitude of FT", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 2,
		     -command => sub{tft_plot_r(\%tft_params, 'm')},)
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');

  ++$row;
  $fr -> Radiobutton(-text=>"Plot real part of FT", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 3,
		     -command => sub{tft_plot_r(\%tft_params, 'r')},)
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');

  ++$row;
  $fr -> Radiobutton(-text=>"Plot BFT + sum*window", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 4,
		     -command => sub{tft_plot_kq(\%tft_params)},)
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');

  ++$row;
  $fr -> Radiobutton(-text=>"Plot edge step", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 5,
		     -command => sub{tft_plot_step(\%tft_params)},)
    -> grid(-row=>$row, -column=>0, -columnspan=>4, -sticky=>'w');
  ++$row;
  $fr -> Radiobutton(-text=>"Plot FT of edge step", ,
		     -variable	  => \$tft_params{plot},
		     -selectcolor => $red,
		     -value	  => 6,
		     -command => sub{tft_plot_stepft(\%tft_params)},)
    -> grid(-row=>$row, -column=>0, -columnspan=>3, -sticky=>'w');
  $fr -> Button(-text=>"Replot", @button_list,
		-command => sub{tft_replot(\%tft_params)}
	       )
    -> grid(-row=>$row, -column=>3, -sticky=>'ew');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $tft -> Button(-text=>'Return to the main window',  @button_list,
		  -background=>$config{colors}{background2},
		  -activebackground=>$config{colors}{activebackground2},
		  -command=>sub{&reset_window($tft, "understanding FTs", 0);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $tft -> Button(-text=>'Document section: Understanding Fourier transforms', @button_list,
		 -command=>sub{pod_display("bkg::ft.pod")})
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);


  ## and finally....
  tft_plot_waves(\%tft_params);
  $top -> update;

};

sub tft_replot {
  my ($rhash) = @_;
  my @callbacks = (sub{tft_plot_waves($rhash)},
		   sub{tft_plot_windowed($rhash)},
		   sub{tft_plot_r($rhash, 'm')},
		   sub{tft_plot_r($rhash, 'r')},
		   sub{tft_plot_kq($rhash)},
		   sub{tft_plot_step($rhash)},
		   sub{tft_plot_stepft($rhash)},
		  );
  my $this = $callbacks[$$rhash{plot}];
  &$this;
};


sub tft_make_arrays {
  my ($rhash) = @_;
  $$rhash{npts} = int($$rhash{ext}/0.05);
  my $command = q{};
  $command .= sprintf("set t___ft.k = indarr(%d)*0.05\n", $$rhash{npts});
  foreach my $w (qw(r1 r2 r3)) {
    if ($$rhash{$w} > 0) {
      $command .= sprintf("set t___ft.%s = 0.5*sin(t___ft.k*2*%.4f)\n", $w, $$rhash{$w});
    } else {
      $command .= sprintf("set t___ft.%s = zeros(%d)\n", $w, $$rhash{npts});
    };
  };
  $command .= "set t___ft.sum = t___ft.r1 + t___ft.r2 + t___ft.r3\n";
  $command .= sprintf("fftf(t___ft.sum, k=t___ft.k, kweight=0, kmin=%.4f, kmax=%.4f, dk=%.4f, kwindow=%s)\n",
		      $$rhash{kmin}, $$rhash{kmax}, $$rhash{dk}, $$rhash{kwin});
  $command .= sprintf("fftr(real=t___ft.chir_re, imag=t___ft.chir_im, rmin=%.4f, rmax=%.4f, dr=%.4f, rwindow=%s)\n",
		      $$rhash{rmin}, $$rhash{rmax}, $$rhash{dr}, $$rhash{rwin});
  $groups{"Default Parameters"} -> dispose($command, $dmode);
};

sub tft_plot_waves {
  my ($rhash) = @_;
  $top -> Busy;
  tft_make_arrays($rhash);
  my $command = q{};
  $command .= "newplot(t___ft.k, t___ft.sum, color=blue, key=sum, xlabel=\"k (\\A\\u-1\\d)\", ylabel=\"sum of waves\")\n";
  $command .= "plot(title=\"understanding Fourier transforms\")\n";
  my $offset = -1;
  if ($$rhash{r1}>0) {
    $command .= "plot(t___ft.k, \"t___ft.r1+$offset\", color=red, key=\"first wave\")\n";
    $offset--;
  };
  if ($$rhash{r2}>0) {
    $command .= "plot(t___ft.k, \"t___ft.r2+$offset\", color=darkgreen, key=\"second wave\")\n";
    $offset--;
  };
  if ($$rhash{r3}>0) {
    $command .= "plot(t___ft.k, \"t___ft.r3+$offset\", color=darkviolet, key=\"third wave\")\n";
    $offset--;
  };
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
  return $offset;
};

sub tft_plot_windowed {
  my ($rhash) = @_;
  $top -> Busy;
  tft_make_arrays($rhash);
  my $command = q{};
  $command .= "newplot(t___ft.k, t___ft.sum, color=blue, key=sum, xlabel=\"k (\\A\\u-1\\d)\", ylabel=\"sum of waves\")\n";
  $command .= "plot(title=\"understanding Fourier transforms\")\n";
  $command .= "plot(t___ft.k, t___ft.win, color=darkgreen, key=window)\n";
  $command .= "plot(t___ft.k, \"t___ft.sum*t___ft.win\", color=red, key=\"windowed sum\")\n";
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
};

sub tft_plot_r {
  my ($rhash, $part) = @_;
  $part = ($part =~ m{[impr]}) ? $part : 'r';
  $top -> Busy;
  tft_make_arrays($rhash);
  my $command = q{};
  my %suff = ('m'=>'chir_mag', r=>'chir_re', i=>'chir_im', p=>'chir_pha');
  $command .= "newplot(t___ft.r, t___ft.$suff{$part}, xmax=7, color=blue, key=\"FT of sum\", xlabel=\"R (\\A)\", ylabel=\"FT of sum of waves\")\n";
  $command .= "plot(t___ft.r, \"t___ft.$suff{$part}*t___ft.rwin\", color=red, key=\"windowed FT\")\n";
  $command .= "plot(t___ft.r, t___ft.rwin, color=darkgreen, key=window)\n";
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
};

sub tft_plot_kq {
  my ($rhash) = @_;
  $top -> Busy;
  tft_make_arrays($rhash);
  my $offset = abs(tft_plot_waves($rhash));
  my $command = q{};
  #$command .= "newplot(t___ft.k, \"t___ft.sum*t___ft.win\", xmax=$$rhash{ext}, key=\"windowed sum\", color=blue, xlabel=\"k (\\A\\u-1\\d)\", ylabel=\"sum of waves\")\n";
  #$command .= "plot(title=\"understanding Fourier transforms\")\n";
  $command .= "plot(t___ft.q, t___ft.chiq_re, color=deeppink, xmax=$$rhash{ext}, key=backtransform)\n";
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
};

sub tft_step_arrays {
  my ($rhash) = @_;
  my $command = q{};
  $command .= sprintf("set t___ft.k = indarr(%d)*0.05\n", $$rhash{npts});
  $command .= sprintf("set t___ft.r%s = 0.5*sin(t___ft.k*2*%.4f)\n", 1, $$rhash{r1});
  $command .= sprintf("set t___ft.step = 0.5*(1+erf(t___ft.k-%.3f))*(1+0.1*t___ft.r%s)\n",  $$rhash{npts}/4*0.05, 1);
  return $command;
};

sub tft_plot_step {
  my ($rhash) = @_;
  $top -> Busy;
  my $command = tft_step_arrays($rhash);
  $command .= "newplot(t___ft.k, t___ft.step, color=blue, xmax=$$rhash{ext}, key=\"step function + 2 \\A wave\")\n";
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
};

sub tft_plot_stepft {
  my ($rhash) = @_;
  $top -> Busy;
  my $command = tft_step_arrays($rhash);
  $command .= sprintf("fftf(t___ft.step, k=t___ft.k, kweight=0, kmin=%.4f, kmax=%.4f, dk=%.4f, kwindow=%s)\n",
		      0, $$rhash{kmax}, $$rhash{dk}, $$rhash{kwin});
  $command .= "newplot(t___ft.r, t___ft.chir_mag, color=blue, xmax=7, key=\"FT of step function + 2\\A wave\")\n";
  $command .= "plot_arrow(x1=2, y1= 2, x2=2, y2=0.5,  barb=0, size=1)\n";
  $command .= "plot_text(x=2,y=2.3, text='location of 2\\A peak')\n";
  $groups{"Default Parameters"} -> dispose($command, $dmode);
  $top -> Unbusy;
};
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2006 Bruce Ravel
##
##  This file contains the dialog for making a series of copies of a data group

sub series {

  ## generally, we do not change modes unless there is data.
  ## exceptions include things like the prefernces and key bindings,
  ## which are data-independent
  Echo("No data!"), return unless $current;
  Echo("No data!"), return if ($current eq "Default Parameters");

  ## this is a way of testing the current list of data groups for some
  ## necessary property.  for the demo, this will just be the list of
  ## groups
  # my @keys = ();
  # foreach my $k (&sorted_group_list) {
  #   ($groups{$k}->{is_xmu}) and push @keys, $k;
  # };
  # Echo("You need two or more xmu groups to foobar"), return unless ($#keys >= 1);
  my @keys = &sorted_group_list;

  ## you must define a hash which will contain the parameters needed
  ## to perform the task.  the hash_pointer global variable will point
  ## to this hash for use in set_properties.  you might draw these
  ## values from configuration parameters, as in the commented out
  ## example
  my %series_params;
  $series_params{group} = $current;
  $series_params{label} = $groups{$current}->{label};

  ## you may wish to provide a better guess for which should be the
  ## standard and which the unknown.  you may also want to adjust the
  ## view of the groups list to show the unknown -- the following
  ## works...
  my $here = ($list->bbox($groups{$current}->{text}))[1] - 5  || 0;
  ($here < 0) and ($here = 0);
  my $full = ($list->bbox(@skinny_list))[3] + 5;
  $list -> yview('moveto', $here/$full);


  ## these two global variables must be set before this view is
  ## displayed.  these are used at the level of set_properties to
  ## perform chores appropriate to this dialog when changing the
  ## current group
  $fat_showing = 'series';
  $hash_pointer = \%series_params;

  ## disable many menus.  this makes the chore of managing the views
  ## much easier.  the idea is that the main view is "home base".  if
  ## you want to do a different analysis chore, you must first return
  ## to the main view
  map {$_ -> configure(-state=>'disabled')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);

  ## this removes the currently displayed view without destroying its
  ## contents
  $fat -> packForget;

  ## define the parent Frame for this analysis chore and pack it in
  ## the correct location
  my $series = $container->Frame(@fatgeom, -relief=>'sunken', -borderwidth=>3)
    -> pack(-fill=>'both', -expand=>1);
  #$series -> packPropagate(0);
  ## global variable identifying which Frame is showing
  $which_showing = $series;

  ## the standard label along the top identifying this analysis chore
  $series -> Label(-text=>"Create a series of data group copies",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'x', -anchor=>'w');

  ## a good solution to organizing widgets is to stack frames, so
  ## let's make a frame for the standard and the other.  note that the
  ## "labels" are actually flat buttons which display hints in the
  ## echo area
  my $frame = $series -> Frame(-borderwidth=>2, -relief=>'sunken')
    -> pack(-side=>'top', -fill=>'x');
  $frame -> Label(-text=>"Group:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>0, -column=>0, -sticky=>'e', -pady=>3);
  $widget{safluo_group} = $frame -> Label(-anchor=>'w', -textvariable=>\$series_params{label})
    -> grid(-row=>0, -column=>1, -sticky=>'ew', -pady=>3);



  ## this is a spacer frame which pushes all the widgets to the top
  $series -> Frame(-background=>$config{colors}{darkbackground})
    -> pack(-side=>'bottom', -expand=>1, -fill=>'both');

  ## at the bottom of the frame, there are full width buttons for
  ## returning to the main view and for going to the appropriate
  ## document section
  $series -> Button(-text=>'Return to the main window',  @button_list,
		    -background=>$config{colors}{background2},
		    -activebackground=>$config{colors}{activebackground2},
		    -command=>sub{## clean-up chores, for instance you
                                  ## may need to toggle update_bkg or
                                  ## one of the others

		                  ## restore the plot ranges is they
		                  ## were changed
		                  ## finally restore the main view
		                  &reset_window($series, "series", 0);
			       })
    -> pack(-side=>'bottom', -fill=>'x');
  ## help button
  $series -> Button(-text=>'Document section:  copying groups', @button_list,
		    -command=>sub{pod_display("ui::glist.pod") })
    -> pack(-side=>'bottom', -fill=>'x', -pady=>4);

  tie my %params, "Tie::IxHash";
  %params = ('bkg_e0'    => 'Background removal E0',
	     'bkg_rbkg'  => 'Background removal R_bkg',
	     'bkg_kw'    => 'Background removal k-weight',
	     'bkg_pre1'  => 'Lower end of pre-edge range',
	     'bkg_pre2'  => 'Upper end of pre-edge range',
	     'bkg_nor1'  => 'Lower end of normalization range',
	     'bkg_nor2'  => 'Upper end of normalization range',
	     'bkg_spl1'  => 'Lower end of spline range',
	     'bkg_spl2'  => 'Upper end of spline range',
	     'fft_kmin'  => 'Fourier tranform minimum k',
	     'fft_kmax'  => 'Fourier tranform maximum k',
	     'fft_dk'    => 'Fourier tranform sill width',
	     'bft_rmin'  => 'Back tranform minimum R',
	     'bft_rmax'  => 'Back tranform maximum R',
	     'bft_dr'    => 'Back tranform sill width',
	    );
  $series_params{param} = 'bkg_rbkg';
  $series_params{plab}  = $params{'bkg_rbkg'};
  $frame -> Label(-text=>"Parameter:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>1, -column=>0, -sticky=>'e', -pady=>3);
  $widget{series_param} = $frame -> Optionmenu(-font=>$config{fonts}{small},
					       -textvariable => \$series_params{plab},
					       -borderwidth=>1,
					      )
    -> grid(-row=>1, -column=>1, -sticky=>'ew', -pady=>3);
  foreach my $i (keys %params) {
    $widget{series_param} -> command(-label => $params{$i},
				     -command =>
				     sub{
				       $series_params{param}   = $i;
				       $series_params{plab}    = $params{$i};
				       $series_params{current} = sprintf("%.3f", $groups{$current}->{$i});
				       $series_params{begin}   = sprintf("%.3f", $groups{$current}->{$i});
				       $series_params{inc}     = ($i eq 'bkg_e0') ? 5 : sprintf("%.3f", abs($groups{$current}->{$i}) / 10);
				     });
  };

  $series_params{current} = $groups{$current}->{'bkg_rbkg'};
  $frame -> Label(-text=>"Current value:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>2, -column=>0, -sticky=>'e', -pady=>3);
  $widget{series_current} = $frame -> Label(-anchor=>'w',
					    -textvariable=>\$series_params{current})
    -> grid(-row=>2, -column=>1, -sticky=>'ew', -pady=>3);

  $series_params{begin} = $groups{$current}->{'bkg_rbkg'};
  $frame -> Label(-text=>"Beginning value:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>3, -column=>0, -sticky=>'e', -pady=>3);
  $widget{series_begin} = $frame -> Entry(-textvariable=>\$series_params{begin})
    -> grid(-row=>3, -column=>1, -sticky=>'ew', -pady=>3);

  $series_params{number} = 4;
  $frame -> Label(-text=>"Number of copies:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>4, -column=>0, -sticky=>'e', -pady=>3);
  $widget{series_number} = $frame -> Entry(-textvariable=>\$series_params{number})
    -> grid(-row=>4, -column=>1, -sticky=>'ew', -pady=>3);

  $series_params{inc} = 0.1;
  $frame -> Label(-text=>"Increment:",
		  -foreground=>$config{colors}{activehighlightcolor},)
    -> grid(-row=>5, -column=>0, -sticky=>'e', -pady=>3);
  $widget{series_inc} = $frame -> Entry(-textvariable=>\$series_params{inc})
    -> grid(-row=>5, -column=>1, -sticky=>'ew', -pady=>3);

  $frame -> Button(-text=>'Make copies', @button_list,
		   -command=>
		   sub{
		     Echo("Series of copied groups ($series_params{plab}) ...");
		     my $save = $series_params{begin};
		     $top -> Busy;
		     series_copy(\%series_params);
		     series_plot(\%series_params);
		     Echo("Series of copied groups ($series_params{plab}) ... done!");
		     $series_params{begin} = $save;
		     $top -> Unbusy;
		   },
		  )
    -> grid(-row=>6, -column=>0, -columnspan=>2, -sticky=>'ew', -pady=>3);


  ## do you need to run one of your analysis subroutines immediately?
  ## now is a good time...

  ## and finally....
  $top -> update;

};


sub series_copy {
  my ($rparams) = @_;
  ##print join(" ", %$rparams), $/;
  my $was   = $current;
  my ($p, $begin, $inc) = ($rparams->{param}, $rparams->{begin}, $rparams->{inc});
  mark('none');
  mark('this');
  foreach my $i (1 .. $rparams->{number}) {
    my $new = &copy_group;
    my $val = $begin+($i-1)*$inc;
    my $pp  = (split(/_/, $p))[1];
    $groups{$new} -> make($p => $val);
    my $label = $groups{$was}->{label} . " - $pp=$val";
    rename_group($dmode, $label, $new);
    set_properties(0, $was);
  };
};

sub series_plot {
  my ($rparams) = @_;
  my $type  = (split(/_/, $rparams->{param}))[0];
  plot_marked_k if ($type eq 'bkg');
  plot_marked_r if ($type eq 'fft');
  plot_marked_q if ($type eq 'bft');
};


## END OF SERIES COPY SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Athena, copyright (c) 2001-2008 Bruce Ravel
##
##  This section of the code contains miscellaneous subroutine which
##  do not fit in other sections


sub BindMouseWheel {		# Mastering Perl/Tk ch. 15, p. 370
  my ($w) = @_;
  if ($^O eq 'MSWin32') {
    $w->bind('<MouseWheel>' =>
	     [ sub { $_[0]->yview('scroll', -($_[1]/120)*3, 'units') },
	       Ev('D') ]
	     );
  } elsif ($^O eq 'linux') {
    ## on linux the mousewheel works by mapping to buttons 4 and 5
    $w->bind('<4>' => sub { $_[0]->yview('scroll', -1, 'units') unless $Tk::strictMotif; });
    $w->bind('<5>' => sub { $_[0]->yview('scroll', +1, 'units') unless $Tk::strictMotif; });
  };
};


## turn off the mouse wheel
sub disable_mouse_wheel {
  my $w = $_[0];
  my @swap_bindtags = $w->bindtags;
  $w -> bindtags([@swap_bindtags[1,0,2,3]]);
  if ($^O eq 'MSWin32') {
    $w -> Tk::bind('<MouseWheel>' => sub{$_[0]->break});
  } else {
    $w -> Tk::bind('<4>' => sub{$_[0]->break});
    $w -> Tk::bind('<5>' => sub{$_[0]->break});
  };
};

## turn off the mouse-3 pop-up menu which is normal for a text widget
sub disable_mouse3 {
  my $text = $_[0];
  my @swap_bindtags = $text->bindtags;
  $text -> bindtags([@swap_bindtags[1,0,2,3]]);
  $text -> bind('<Button-3>' => sub{$_[0]->break});
};


sub about_demos {
  my $info = <<EOH
Demo projects are the best way to learn about the many features of
Athena.

They are project files that have been specially prepared to
demonstrate different aspects of Athena.  The name of the project
should give a hint as to which feature is being demonstrated.  Each of
the demo projects has extensive documentation and many hints about
things to try written in the journal.

To read the journal once you have imported the demo project, either
select "Write in project journal" from the Edit menu or hit Control-6.

EOH
  ;
  ## tidy up for display
  $info =~ s/\n/ /g;
  $info =~ s/ /\n\n/g;
  my $dialog =
    $top -> Dialog(-bitmap         => 'info',
		   -text           => $info,
		   -title          => 'Athena: About demo projects',
		   -buttons        => [qw/OK/],
		   -default_button => 'OK');
  my $response = $dialog->Show();
};


## this should probably be called "doc_display" or some such
sub pod_display {
  my ($file) = @_;

  ## a pm file goes straight to the pod browser
  if ($file =~ m{pm$}) {
    pod_post($file);
    return 1;
  };

  ## fire up a browser with the local html version of the pod  WWWBrowser vs. Tk::Pod::WWWBrowser ???
  my $succeeded = 0;
  if (($config{doc}{prefer} eq "html") and (eval { require WWWBrowser })) {
    my @list = @WWWBrowser::unix_browsers;
    unshift @list, $config{doc}{browser} if not $is_windows;
    @WWWBrowser::unix_browsers = @list;
    my $url = File::Spec->catfile(File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'aughtml'),
						      split("::", $file)));
    $url =~ s{pod$}{html};
    $succeeded = WWWBrowser::start_browser($url) if (-e $url);
  };
  return 1 if $succeeded;

  ## fire up browser with remote version of html
  ##  -- need a way to determine if we are online

  ## pod version of user's guide is installed
  if (-e File::Spec->catfile($groups{"Default Parameters"} -> find('athena', 'augpod'), "index.pod")) {
    pod_post($file);
    $succeeded = 1;
  };
  return 1 if $succeeded;

  ## cannot find any form of the document
  my $info = <<EOH
It seems that you have not installed the Athena User's Guide.

The User's Guide is distributed separately from the rest of Athena.
Go to

http://cars9.uchicago.edu/iffwiki/BruceRavel/EvolvingSoftware

and follow the simple installation instructions.

EOH
  ;
  $info =~ s{\n}{ }g;		## tidy up for display
  $info =~ s{ }{\n\n}g;
  my $dialog =
    $top -> Dialog(-bitmap         => 'info',
		   -text           => $info,
		   -title          => 'Athena: Missing document',
		   -buttons        => [qw/OK/],
		   -default_button => 'OK');
  my $response = $dialog->Show();
  return 0

};

sub pod_post {
  my ($file) = @_;
  my $p = $top->Pod(-file=>$file);
  $p->zoom_in foreach (1 .. $config{doc}{zoom});
};


sub quit_athena {
  my $ngroups = 0;
  foreach (keys %marked) { ++$ngroups };
  if ($ngroups and $config{general}{query_save} and !$project_saved) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "Would you like to save this project before exiting?",
		     -title          => 'Athena: Exiting...',
		     -buttons        => [qw/Yes No Cancel/],
		     -default_button => $config{general}{quit_query});
    my $response = $dialog->Show();
    ($response eq 'Cancel') and return;
    $config{general}{quit_query} = $response;
    my $config_ref = tied %config;
    $config_ref -> WriteConfig($personal_rcfile);
    ($response eq 'Yes') and &save_project('all');
  };

  ## clean up stash directory
  if ($config{general}{purge_stash}) {
    opendir C, $stash_dir;
    map { my $f = File::Spec->catfile($stash_dir, $_);
	  -f $f and unlink $f}
      (grep !/(^\.{1,2}|TRAP)$/, readdir C);
    closedir C;
  };
  unlink($groups{"Default Parameters"}->find('athena', 'temp_lcf'))
    if (-e $groups{"Default Parameters"}->find('athena', 'temp_lcf'));

  $mru{config}{last_working_directory} = $current_data_dir;

  ## remember the geometry, save it in the mru file
  my ($height, $width, $x, $y) = split(/[x+]/, $top->geometry);
  $mru{geometry}{height} = $height;
  $mru{geometry}{width}  = $width;
  $mru{geometry}{'x'}    = $x;
  $mru{geometry}{'y'}    = $y;
  tied(%mru) -> WriteConfig($mrufile);

  $top->destroy();
  exit;
};


## move rc and mru files from their 0.8.016 and earlier locations to
## the .horae directory
sub convert_config_files {
  my $horae_dir = $groups{"Default Parameters"} -> find('athena', 'horae');
  (-d $horae_dir) or mkpath($horae_dir);
  my $rcfile    = $groups{"Default Parameters"} -> find('athena', 'oldrc');
  my $rctarget  = $groups{"Default Parameters"} -> find('athena', 'rc_personal');
  my $mrufile   = $groups{"Default Parameters"} -> find('athena', 'oldmru');
  my $mrutarget = $groups{"Default Parameters"} -> find('athena', 'mru');
  ##print join(" ", $horae_dir, $rcfile, $rmrufile), $/;
  move($rcfile,  $rctarget)  if (-e $rcfile);
  move($mrufile, $mrutarget) if (-e $mrufile);
};

sub clean_old_trap_files {
  opendir S, $stash_dir;
  my @list = grep {/ATHENA/} readdir S;
  closedir S;
  map {unlink File::Spec->catfile($stash_dir, $_)} @list;
};


sub stash_directory {
  my $dir = $groups{"Default Parameters"} -> find('athena', 'horae');
  (-d $dir) or mkpath($dir);
  $dir = File::Spec->catfile($dir, "stash");
  (-d $dir) or mkpath($dir);
  $dir = $groups{"Default Parameters"} -> find('athena', 'userfiletypedir');
  (-d $dir) or mkpath($dir);
  $dir = $groups{"Default Parameters"} -> find('other', 'downloads');
  (-d $dir) or mkpath($dir);
  return $stash_dir;
};


## display $str in echo area, $app true means to append $str to what
## is already there
sub Echo {
  my ($str, $app) = @_;
  my $text = $echo -> cget('-text');
  ($str eq " ... done!") and ($text =~ s/ ... done!$//);
  ($app) and ($str = $text . $str);

  push @echo_history, $str;
  ## ($#echo_history > 2000) and shift @echo_history;
  $notes{echo} -> insert('end', $str."\n", "text");
  $notes{echo} -> yviewMoveto(1);

  ## strip off the character identifying the echo string as coming from Group.pm
  $str =~ s/^\>\s*//;
  if ($echo_pause) {
    $top -> after($echo_pause,
		  sub{$echo -> configure(-text=>(length($str) > 110) ?
					 substr($str, 0, 110)." ..." : $str);
		    });
  } else {
    $echo -> configure(-text=>(length($str) > 110) ?
		       substr($str, 0, 110)." ..." : $str);
  };
  $top -> update;
};

sub Error { $top->bell; Echonow(@_); };

sub Echonow { my $old=$echo_pause; $echo_pause=0; Echo(@_); $echo_pause=$old};


sub show_hint {
  Echo("Hints file was not found"), return unless @hints;
  $hint_n = int(rand $#hints);
  Echo("HINT: " . $hints[$hint_n]);
  #++$hint_n;
  #($hint_n > $#hints) and $hint_n = 0;
};

## this brings up the menu when a group in the skinny panel is
## right-clicked upon
sub GroupsPopupMenu {
 my ($w, $item, $X, $Y) = @_;
 set_properties(2, $item, 0);
 if (@_ < 3) {
   my $e = $w->XEvent;
   $X = $e->X;
   $Y = $e->Y;
 };
 $group_menu->Post($X,$Y) if defined $group_menu;
}

sub Leave {
  my $this = shift;
  my @normal   = (-fill => $config{colors}{foreground},); # -font => $config{fonts}{med},
  my @rect_out = (-fill => $config{colors}{background}, -outline=>$config{colors}{background});
  $this->configure(-cursor => 'top_left_arrow');
  return if not exists($groups{$current}->{bindtag});
  return if not $this->itemcget('current', '-tags');
  if ($this->itemcget('current', '-tags')->[0] ne $groups{$current}->{bindtag}) {
    my $x = $this->find(below=>'current');
    $this->itemconfigure($x, @rect_out,);
  };
};


## Dump the current states of important hashes to a file
sub Dumpit {
  Echo("Dumping groups and marked to \`athena.dump\'");
  $Data::Dumper::Indent = 2;
  open DUMP, ">athena.dump" or die $!;
  print DUMP Data::Dumper->Dump([\$current, \%groups, \%marked, \%lcf_data],
				[qw/current groups marked lcf_data/]);
  close DUMP;
  $Data::Dumper::Indent = 0;
  Echo("Dumping groups and marked to \`athena.dump\' ... done!");
};


sub reset_window {
  my ($parent, $which, $r_save) = @_;
  $parent -> packForget;
  undef $parent;
  $fat -> pack(-fill=>'both', -expand=>1);
  ##$peak->grabRelease; $peak->destroy;
  map {$_ -> configure(-state=>'normal')}
    ($data_menu, $merge_menu, $anal_menu, $settings_menu);
  $fat_showing = 'normal';
  $which_showing = undef;
  $hash_pointer = undef;
  set_properties(1, $current, 0) if ($current);
  ##print join(" ", $r_save, @$r_save), $/;
  if ($r_save) {
    my $ps = $project_saved;
    ($plot_features{emin}, $plot_features{emax}) = @$r_save;
    project_state($ps);		# don't toggle if currently saved
  };
  Echo("Done with $which.  Normal view has been returned.");
};

sub swap_panels {
  if (grep {$_ eq 'right'} ($skinny -> packInfo())) {
    $config{general}{fatside}  = 'right';
    $config{general}{listside} = 'left';
    $list -> configure(-scrollbars=>'w');
    $po_left -> packForget;
    $po -> packForget;
    $po_right -> packForget;
    $po -> pack(-side=>'left', -fill => 'x', -expand=>1);
    $po_right -> pack(-side=>'left', -anchor=>'n');
  } else {
    $config{general}{fatside}  = 'left';
    $config{general}{listside} = 'right';
    $list -> configure(-scrollbars=>'e');
    $po_left -> packForget;
    $po -> packForget;
    $po_right -> packForget;
    $po_left -> pack(-side=>'left', -anchor=>'n');
    $po -> pack(-side=>'left', -fill => 'x', -expand=>1);
  };
  $skinny -> pack(-side=>$config{general}{listside});
  $container -> pack(-side=>$config{general}{fatside});
};


sub z_popup {
  return if ($groups{$current}->{frozen});
  my ($curr, $which) = @_;
  ($menus{bkg_z}, $menus{fft_edge}) = find_edge($groups{$current}->{bkg_e0});
  $groups{$current} -> make(bkg_cl=>($which =~ /^cl/) ? 1 : 0,
			    bkg_z=>$menus{bkg_z},
			    fft_edge=>$menus{fft_edge},
			    update_fft=>($which eq 'pc'),
			   );
  $groups{$current} -> make(update_bkg=>($which eq 'cl')) unless $groups{$current}->{update_bkg};
  $groups{$current} -> plotE('emzn',$dmode,\%plot_features, \@indicator), return if ($which =~ /update/);
  my $popup = $top -> Toplevel(-class=>'horae');
  $popup -> protocol(WM_DELETE_WINDOW => sub{$popup->destroy});
  $popup -> title("Athena: Central atom species");
  $popup -> bind('<Control-d>' => sub{($which eq 'cl') and
					$groups{$current} -> plotE('emzn',$dmode,\%plot_features, \@indicator);
				      $popup->destroy;});
  $popup -> bind('<Control-q>' => sub{($which eq 'cl') and
					$groups{$current} -> plotE('emzn',$dmode,\%plot_features, \@indicator);
				      $popup->destroy;});
  my $note = ($absorption_exists) ? "\nA guess has been made, but it may not be correct" : "";
  $popup -> Label(-text=>"You have selected a feature of Athena that\nneeds to know the species\nof the central atom in this data set.".$note)
    -> pack();
  my $frame = $popup -> Frame(-borderwidth=>2, -relief=>'groove')
    -> pack(-pady=>4);
  $frame -> Label(-text=>'Choose an atom type:')
    -> pack(-side=>'left');
  my $menu = $frame -> Optionmenu(-textvariable => \$menus{bkg_z}, -width=>4)
    -> pack(-side=>'right');
  foreach my $l ([1..20], [21..40], [41..60], [61..80], [81..92]) {
    my $cas = $menu ->
      cascade(-label => get_symbol($$l[0]) . " to " . get_symbol($$l[$#{$l}]),
	      -tearoff=>0 );
    foreach my $i (@$l) {
      $cas -> command(-label => $i . ": " . get_symbol($i),
		      -command=>
		      sub{$menus{bkg_z}=get_symbol($i);
			  $groups{$current}->make(bkg_cl=>($which =~ /^cl/),
						  bkg_z=>$menus{bkg_z},
						  update_bkg=>($which =~ /^cl/),
						  update_fft=>($which eq 'pc'));
			  project_state(0);
			  ($which eq 'cl') and
			    $groups{$current} -> plotE('emzn',$dmode,\%plot_features, \@indicator);
			  $popup->destroy;
			});
    };
  };
  $frame = $popup -> Frame() -> pack(-expand=>1, -fill=>'x');
  $frame -> Button(-text=>'OK',                            # emzn ?
		   -command=>sub{($which eq 'cl') and
				   $groups{$current} -> plotE('emzn',$dmode,\%plot_features, \@indicator);
				 $popup->destroy; })
    -> pack(-expand=>1, -fill=>'x');
  $top->update;
  $popup -> raise;
  $popup -> grab;
};


## From the current value of the edge energy for the current group,
## attempt to determine what element this is.  The criterion is
## closeness to a tabulated edge energy found by brute force,
## linear searching.  That requires that Xray::Absorption is installed.
sub find_edge {
  return ('H', 'K') unless ($absorption_exists);
  my $input = $_[0];
  my ($edge, $answer, $this) = ("K", 1, 0);
  my $diff = 100000;
  foreach my $ed (qw(K L1 L2 L3)) {  # M1 M2 M3 M4 M5
  Z: foreach (1..104) {
      last Z unless (Xray::Absorption->in_resource($_));
      my $e = Xray::Absorption -> get_energy($_, $ed);
      next Z unless $e;
      $this = abs($e - $input);
      last Z if (($this > $diff) and ($e > $input));
      if ($this < $diff) {
	$diff = $this;
	$answer = $_;
	$edge = $ed;
	#print "$answer  $edge\n";
      };
    };
  };
  my $elem = get_symbol($answer);
  if ($config{general}{rel2tmk}) {
    ## give special treatment to the case of fe oxide.
    ($elem, $edge) = ("Fe", "K")  if (($elem eq "Nd") and ($edge eq "L1"));
    ## give special treatment to the case of mn oxide.
    ($elem, $edge) = ("Mn", "K")  if (($elem eq "Ce") and ($edge eq "L1"));
    ## prefer Bi K to Ir L1
    ($elem, $edge) = ("Bi", "L3") if (($elem eq "Ir") and ($edge eq "L1"));
    ## prefer Se K to Tl L2
    ($elem, $edge) = ("Se", "K")  if (($elem eq "Tl") and ($edge eq "L3"));
    ## prefer Pt L3 to W L2
    #($elem, $edge) = ("Pt", "L3") if (($elem eq "W") and ($edge eq "L2"));
    ## prefer Se K to Pb L2
    ($elem, $edge) = ("Rb", "K")  if (($elem eq "Pb") and ($edge eq "L2"));
    ## prefer Np L3 to At L1
    #($elem, $edge) = ("Np", "L3")  if (($elem eq "At") and ($edge eq "L1"));
    ## prefer Cr K to Ba L1
    ($elem, $edge) = ("Cr", "K")  if (($elem eq "Ba") and ($edge eq "L1"));
  };
  return ($elem, $edge);
};



sub set_status {
  return if (Ifeffit::Tools->vstr < 1.02007);
  my $val = $_[0] || 0;
  $groups{"Default Parameters"} -> dispose("set \&status = $val", $dmode);
};


sub splash_message {
  my ($message) = @_;
  $splash_status -> configure(-text=>$message);
  $top -> update;
  #sleep 1;
};


## I got this off of Usenet.  Do a search at groups.google.com for the
## package to find discussions of slow dialog boxes.  The text of this
## will be among the discussions.
package Patch::SREZIC::Tk::Wm;

use Tk::Wm;
package Tk::Wm;

sub Post
{
 my ($w,$X,$Y) = @_;
 $X = int($X);
 $Y = int($Y);
 $w->positionfrom('user');
 # $w->geometry("+$X+$Y");
 $w->MoveToplevelWindow($X,$Y);
 $w->deiconify;
# $w->idletasks; # to prevent problems with KDE's kwm etc.
# $w->raise;
}

## work around an issue in the 18 Dec 2008 release of Tk 804.028
package Patch::BR::Tk::FBox;
use Tk::FBox;
package Tk::FBox;
sub _get_select_Path {
    my($w) = @_;
    $w->_encode_filename($w->{'selectPath'});
};

1;


## END OF MISCELLANEOUS SUBSECTION
##########################################################################################
