#!/usr/bin/perl -w                # -*-cperl-*-
######################################################################
## Artemis: graphical data analysis using ifeffit
##
##                     Artemis is copyright (c) 2002-2006 Bruce Ravel
##                                                     bravel@anl.gov
##                                  http://cars9.uchicago.edu/~ravel/
##
##                   Ifeffit is copyright (c) 1992-2006 Matt Newville
##                                         newville@cars.uchicago.edu
##                                  http://cars.uchicago.edu/ifeffit/
##
##	  The latest version of Artemis 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.
## -------------------------------------------------------------------
######################################################################
## -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-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 "Artemis requires Tk version 800.022 or later\n"  if ($Tk::VERSION < 800.022);
  #require Ifeffit;
  #die "Artemis requires Ifeffit.pm version 1.2 or later\n" if ($Ifeffit::VERSION < 1.2);
  #import Ifeffit qw/ifeffit/;
  use Ifeffit qw(ifeffit get_array put_array);
  ifeffit("\&screen_echo = 0\n");
};

use strict;
## use diagnostics;

## The next line is not necessary when artemis is run as an
## interpretted script but PAR needs some help knowing which Tk
## modules to load.
use Tk::widgets qw(Wm Derived Frame NoteBook Tree Bitmap Button Optionmenu Dialog
                   DialogBox TextUndo TextUndoQuiet ROText
                   Checkbutton Entry Label Radiobutton Scrollbar Canvas HList
		   Pixmap ItemStyle Splashscreen Photo waitVariableX
		   PathparamEntry Pane NumEntry NumEntryPlain FireButton
		   LabFrame Pod Pod/Text Pod/Search Pod/Tree More Listbox
		   FileSelect Menu BrowseEntry);
### wtf?!?!  PerlApp needs this line:
use Tk::DirTree;
use Tk::Pod;
use Tk::TextUndo;
use Tk::TextUndoQuiet;
##use Tk::bindDump;
use Ifeffit::Path;
use Ifeffit::Parameter;
use Ifeffit::ArtemisLog;
use Ifeffit::Files;
use Ifeffit::ParseFeff;
##my $absorption_exists = (eval "require Xray::Absorption");
use Xray::Absorption;
use Cwd;
use File::Basename;
use File::Copy;
use File::Path;
use File::Compare;
use Chemistry::Elements qw(get_symbol get_name get_Z);
use Compress::Zlib;
use Math::Round qw(round);
use Text::Wrap;
$Text::Wrap::columns = 65;
use Text::ParseWords;
use Digest::MD5 qw(md5_hex);
use Data::Dumper;
use Safe;
use Fcntl;
use Config::IniFiles;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Xray::Xtal;
$Xray::Xtal::run_level = 3;
use Xray::Atoms qw(build_cluster rcfile_name);
use Xray::ATP; # qw(parse_atp);
use Xray::Tk::SGB;
my $STAR_Parser_exists = (eval "require STAR::Parser");
if ($STAR_Parser_exists) {
  import STAR::Parser;
};
use constant PI => 3.14159265358979323844;
use constant THIRD => 1/3;
use constant TWOTH => 2/3;
use constant EPSILON => 0.00001;
use constant DELTA => 0.001;


my $VERSION = "0.8.014";
my $is_windows = (($^O eq 'MSWin32') or ($^O eq 'cygwin'));
my $mouse_over_cursor = 'mouse';

my $vstr = Ifeffit::Tools->vstr;
if ($vstr < 1.02005) {
  my $mw = MainWindow->new();
  $mw -> withdraw();
  my $message = "This version of Artemis requires Ifeffit 1.2.5 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 =
    $mw -> Dialog(-bitmap         => 'error',
		  -text           => $message,
		  -title          => 'Artemis: Exiting...',
		  -buttons        => [qw/OK/],
		  -default_button => 'OK',
		  -font           => ($is_windows) ? "Helvetica 8 normal" : "Helvetica 12 normal",
		  -popover        => 'cursor');
  my $response = $dialog->Show();
  exit;
};


unless (($VERSION eq $Ifeffit::Path::VERSION)       and
	($VERSION eq $Ifeffit::Parameter::VERSION)  and
	($VERSION eq $Ifeffit::ArtemisLog::VERSION))    {
  my $mw = MainWindow->new();
  $mw -> withdraw();
  my $message = "Artemis appears to be installed incorrectly.

The main program and one or more of the Ifeffit/Path.pm,
Ifeffit/Parameter.pm, and Ifeffit/ArtemisLog.pm
modules have different version numbers.

main program:  $0
Path.pm:       $INC{'Ifeffit/Path.pm'}
Parameter.pm:  $INC{'Ifeffit/Parameter.pm'}
ArtemisLog.pm: $INC{'Ifeffit/ArtemisLog.pm'}
";
  my $dialog =
    $mw -> Dialog(-bitmap         => 'error',
		  -text           => $message,
		  -title          => 'Artemis: Exiting...',
		  -buttons        => [qw/OK/],
		  -default_button => 'OK',
		  -font           => ($is_windows) ? "Helvetica 8 normal" : "Helvetica 12 normal",
		  -popover        => 'cursor');
  my $response = $dialog->Show();
  exit;
};
my $About = "Artemis $VERSION (c) 2002-2008 Bruce Ravel <bravel\@anl.gov> -- NO WARRANTY -- see license for details";
my $About_Ifeffit = "Using Ifeffit ".Ifeffit::get_string("\$&build");
$About_Ifeffit =~ s{\s+}{ }g;
## family????
my $setup = Ifeffit::Path -> new(type=>'data');

## ============================================================================
## ============================================================================
## Define are some global variables
use vars qw(%notecard %notes %labels %props);
my $is_osx     = ($^O eq 'darwin');
my ($n_gsd, $n_feff, $n_data) = (0, 0, 0);
##  my (@gsd_choice, @gsd_name, @gsd_name_widget, @gsd_mathexp,
##      @gsd_button, @gsd_updated);
my @gds_regex = ();
my @gds = ();
my @bad_params = ();
my %gds_styles = ();
my %gds_selected = (which=>0, name=>"", mathexp=>"", type=>"", showing=>"edit");
my %intrp_styles = ();
my @atoms = ();
my %atoms_styles = ();
my $current_data_dir = '';
my $current = '';
my $current_file = '';
my $project_name = '';
my $project_folder = '';
my $project_saved = 1;
my $autosave_filename = "";
my $parameters_changed = 0;
my @athena_fh = ();
my ($sgb, $fefftabs, %feffcard);
my @done = (" done!", 1);
##my @echo_history = ();
my @rename_buffer;
my $generic_name = "artemis.stuff";
my $last_plot = '';
my %fit = (index=>1, count=>0, count_full=>0, new=>1, label=>"", comment=>"", fom=>0);

## (stack, start, offset, invert, indicator, indicators...)
my @extra = (0,0,0,0,0, "");

my (%paths, %widgets, %grab, $list, %atoms_params, %log_params, %ath_params); #, %apa_params);

## this regex matches the Ifeffit::Path object types that are not plotted
my $no_plot_regex = '(feff\d+|gsd|journal)';
  ## all the functions in ifeffit
  ##   (insert (make-regexp '("abs" "min" "max" "sign" "sqrt" "exp" "log"
  ## 		       "ln" "log10" "sin" "cos" "tan" "asin" "acos"
  ## 		       "atan" "sinh" "tanh" "coth" "gamma" "loggamma"
  ## 		       "erf" "erfc" "gauss" "loren" "pvoight" "debye"
  ## 		       "eins" "npts" "ceil" "floor" "vsum" "vprod"
  ## 		       "indarr" "ones" "zeros" "range" "deriv" "penalty"
  ##		       "smooth" "interp" "qinterp" "splint" "eins" "debye")))
my $function_regex = "a(bs|cos|sin|tan)|c(eil|o(s|th))|" .
  "de(bye|riv)|e(ins|rfc?|xp)|floor|ga(mma|uss)|" .
  "in(darr|terp)|l(n|o(g(|10|gamma)|ren))|m(ax|in)|" .
  "npts|ones|p(enalty|voight)|qinterp|r(ange|ebin)|" .
  "s(i(gn|nh?)|mooth|plint|qrt)|" .
  "tanh?|v(prod|sum)|zeros";


my %limits = (			# Ifeffit's limits on things
	      paths_per_set  => Ifeffit::get_scalar('&max_paths') || 100,
	      total_paths    => Ifeffit::get_scalar('&max_paths') || 100,
	      variables      => Ifeffit::get_scalar('&max_varys') || 128,
	      spline_knots   => 32,
	      data_sets      => Ifeffit::get_scalar('&max_data_sets') || 16,
	      output_columns => Ifeffit::get_scalar('&max_output_cols') || 16,
	      );
--$limits{output_columns}; ## one less than its actual value since
                           ## the first column will always be the abscissa

my $dmode = 5;
## ==== DEBUG =====
## $dmode += 16;
## ==== DEBUG =====
my $debug_menu = 0;
my $debug_file_path = 0;

use vars qw($top);
$top = MainWindow->new(-class=>'horae');
$top -> withdraw;
$top -> optionAdd('*font', 'Helvetica 14 bold');
$top -> optionAdd('*font', 'Helvetica 9 bold');
my $splash_background = 'antiquewhite3';
my $splash = $top->Splashscreen();
my $splash_image = $top -> Photo(-file => $setup -> find('artemis', '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       => "Artemis\nversion $VERSION",
		       -background => $splash_background,
		       -width      => 22,
		       -font       => 'Helvetica 14 bold',)
  -> pack(qw/-fill both -expand 1/);
my $splash_status =   $splash_frame -> Label(-text       => q{},
					     -background => $splash_background,
					     -font       => 'Helvetica 9 bold',
					     -justify    => 'left',
					     -borderwidth=> 2,
					     -relief     => 'ridge')
  -> pack(-anchor=>'w', -fill=>'x');
$splash -> Splash;
$top -> update;



## ---------------------------------------------------------------------
## add document location to the Pod path
Tk::Pod->Dir($setup -> find('artemis', 'doc'));

## ============================================================================
## ============================================================================
## read configuration files:
splash_message("Importing configuration files");

## check to see if config and mru files from 0.6.001 or earlier are
## around and convert to new location.
&convert_config_files;

my (%plot_features, $screen, @clist, %header, @op_text);
my $dummy_rcfile     = $setup -> find('artemis', 'rc_dummy');
open I, ">".$dummy_rcfile; print I "[meta]\ndummy_parameter=1\n"; close I;
my $system_rcfile    = $setup -> find('artemis', 'rc_sys');
my $personal_rcfile  = $setup -> find('artemis', 'rc_personal');
my $personal_version = $setup -> find('artemis', 'version_marker');

## config values hardwired in the code
my %default_config;
tie %default_config, 'Config::IniFiles', ();
($screen, @clist) = &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 "[meta]\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 "[meta]\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 "[meta]\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;
$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});


## ---------------------------------------------------------------------
## several things that need to be set now that the config file has
## been read
if ($is_windows) {
  ($config{colors}{check} = 'red2') if ($config{colors}{check} eq 'red4');
};
## this fixes a scalar name collision in ifeffit introduced along with
## the reading of Athena projects and the performing of splines in
## Artemis.
($config{autoparams}{e0} = 'enot') if ($config{autoparams}{e0} eq 'e0');
($config{autoparams}{e0} = 'delr') if ($config{autoparams}{delr} eq 'dr');

map { $plot_features{$_} = $config{plot}{$_}} (keys %{$config{plot}});
$plot_features{rmax_out} = $config{plot}{rmax_out} || 10;
$plot_features{bkg} = 0;
$plot_features{res} = 0;
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});
## $config{general}{workspace} =~ s/\~/$ENV{HOME}/;


##$config{general}{query_save} = 0;

## choose the absorption tables for Atoms
##($absorption_exists) and eval "Xray::Absorption -> load($config{atoms}{absorption_tables})";
Xray::Absorption -> load($config{atoms}{absorption_tables});

## default log type
my @log_type = set_log_style($config{log}{style});

splash_message("Making stash directory");
## establish stash directory
&Ifeffit::Tools::initialize_horae_space;
## my $stash_dir = $config{general}{workspace} || $Ifeffit::Tools::horae_stash_dir;
my $stash_dir = $Ifeffit::Tools::horae_stash_dir;

my $trapfile = File::Spec->catfile($stash_dir, "ARTEMIS.TRAP");
## ---------------------------------------------------------------------

## ============================================================================
## ============================================================================
## open and read most recently used (MRU) file
splash_message("Importing recent files list");
my $mrufile = $setup -> find('artemis', '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("Setting up context help and hints");
## ============================================================================
## click help text strings
my %click_help =
  (## guess, set, def
   'Param. name'			     => "The names of fixed and varied parameters for use in math expressions",
   'Math expression'			     => "Math expressions used to evaluate path parameters, establish constraints, and build fitting models",
   'Grab best fit'			     => "Click on these buttons to insert the best fit values after a fit is finished",
   ## operational parameters
   'Titles'				     => "User-supplied, editable commentary about these data",
   'Data file'				     => "Name of the project data file containing these chi(k) data.",
   'k-range'				     => "The range of the fit or the Fourier transform in k space (this should cover the range of reliable data)",
   'Data controls'			     => "Variables which control how these data are used in the fit.  The include and plot buttons are only relevant to a multiple data set fit.",
   'Fit k-weights'			     => "Weighting factor for chi(k) used in the fit for these data.  (You may fit using 1 or more k-weightings.)",
   'Fourier and fit parameters'		     => "Parameters which determine how the Fourier transforms are made and the range over which the fit is made.",
   'Other parameters'			     => "Other parameters controlling details of the fit to these data.",
   'dk'					     => "Width of the Fourier transform window sill in k space (this is typicaly a one to a few inverse Angstroms)",
   'k window'				     => "Functional form of the Fourier transform window in k space",
   'R-range'				     => "The range of the fit or the Fourier transform in R space (this should cover the peaks you wish to include in your fit)",
   'dr'					     => "Width of the Fourier transform window sill in R space (typical values are between 0 to 1)",
   'R window'				     => "Functional form of the Fourier transform window in R space",
   'Fitting space'			     => "Data space in which to perform the minimization (the authors of Ifeffit and Artemis prefer R space)",
   'Path to use for phase corrections'	     => "Correct Fourier transforms by the full phase shift of the chosen path",
   'Phase corrected Fourier transforms'	     => "Correct Fourier transforms by the phase shift of the central atom",
   'elem'				     => 'The element of the absorber, needed for phase correctioned FTs',
   'edge'				     => 'The absorbtion edge of these data, needed for phase correctioned FTs',
   'Epsilon'				     => "Explicitly specify the measurement uncertainty (in k)   (useful for weighting components of a multi-data set fit)",
   'Minimum reported correlation'	     => "Smallest value of correlation between variables to report once the fit is finished (0.25 to 0.5 are sensible)",
   ## Feff calculation
   'Interpretation of the FEFF calculation'  => "A schematic representation of the paths from a FEFF run (try right-clicking in different places in the box)",
   'Core'				     => "Use these buttons to select the central atom",
   'El.'				     => "Specify the two-letter atomic symbols of each atom in this column (leave the element blank to skip this site)",
   "X"					     => "Specify the x-axis coordinate of each atom in this column",
   "Y"					     => "Specify the y-axis coordinate of each atom in this column",
   "Z"					     => "Specify the z-axis coordinate of each atom in this column",
   "Tag"				     => "Specify a site-specific tag for each atom in this column",
   "Occ."				     => "Set the occupancy of each site between 0 and 100% (not used in the feff.inp atom list!!)",
   "Cluster size"			     => "Enter the radial extent of the cluster of atoms to write to the feff.inp file",
   "Shift vector"			     => "Insert the shift vector values here if this is a space group that needs one",
   "Space group"			     => "Enter the symbol of your space group (Hermann-Maguin, Schoenflies, and index number are all ok)",
   "Edge"				     => "Select the absorption edge to be used in the Feff calculation",
   "A"					     => "Enter the a lattice constant of the unit cell",
   "B"					     => "Enter the a lattice constant of the unit cell",
   "C"					     => "Enter the a lattice constant of the unit cell",
   "Alpha"				     => "Enter the alpha angle of the unit cell (alpha is the angle between b and c)",
   "Beta"				     => "Enter the beta angle of the unit cell (beta is the angle between a and c)",
   "Gamma"				     => "Enter the gamma angle of the unit cell (gamma is the angle between a and b)",
   ## paths
   'FEFF calculation'			     => "The Feff calculation that this path is a part of",
   'feff:'				     => "The path and name of the feffNNNN.dat file",
   'label:'				     => "User-defined text used to describe this path",
   'N:'					     => "The degeneracy of this path (this must be a number and cannot be a variable)",
   'S02:'				     => "A math expression describing all amplitude terms other than degeneracy for this path",
   'E0:'				     => "A math expression defining the energy shift for this path",
   'delE0:'				     => "A math expression defining the energy shift for this path",
   'delR:'				     => "A math expression defining the change in path length relative to R_effective for this path",
   'sigma^2:'				     => "A math expression defining the relative mean square displacement about R_effective for this path",
   'Ei:'				     => "A math expression for the additional broadening this path, in eV",
   '3rd:'				     => "A math expression defining the third cumulant for this path",
   '4th:'				     => "A math expression defining the fourth cumulant for this path",
   'dphase:'				     => "An math expression defining a constant phase offset (useful for DAFS data)",
   'k_array:'				     => "An array modifying the k-axis of this path (use with care!)",
   'phase_array:'			     => "An array-valued math expression for an additional phase shift (use with care!)",
   'amp_array:'				     => "An array-valued math expression for an amplitude correction (use with care!)",
   ## histogram
   'Path list entry'			     => "The text template for the list entries of each bin the histogram",
   'Position column'			     => "The text column containing the bin positions.",
   'Height column'			     => "The text column containing the bin heights.",

   'null'				     => "???",
  );
$click_help{'Path to FEFF:'} = $click_help{'Path to FEFF calculation'};

## ============================================================================
## ============================================================================
## 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 );


## ============================================================================
## ============================================================================
## read hints file and initialize hints
my $hint_file = $setup -> find('artemis', 'hints');
my @hints = ();
my ($hint_n, $hint_x);
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_x = $#hints;
  $hint_n = int(rand $hint_x);
  close HINT;
};


## ============================================================================
## ============================================================================
## begin drawing main window, initialize splash screen, and establish
## key bindings
$top -> setPalette(foreground	       => $config{colors}{foreground},
		   background	       => $config{colors}{background},
		   activeBackground    => $config{colors}{activebackground},
		   disabledForeground  => $config{colors}{disabledforeground},
		   disabledBackground  => $config{colors}{background},
		   highlightColor      => $config{colors}{button},
		   -highlightthickness => 2,
		   -font               => $config{fonts}{med},
		  );
$top -> protocol(WM_DELETE_WINDOW => \&quit_artemis);
$top -> title('Artemis');
$top -> iconname('Artemis');
#my $iconbitmap = $setup -> find('artemis', 'xbm');
#$top -> iconbitmap('@'.$iconbitmap);
my $iconimage = $top -> Photo(-file => $setup -> find('artemis', 'xpm'));
$top -> iconimage($iconimage);

splash_message("Setting up key bindings");
my $multikey = "";
$top -> bind('<Control-a>'     => \&select_all);
$top -> bind('<Control-d>'     => \&keyboard_d);
$top -> bind('<Control-e>'     => \&keyboard_e);
$top -> bind('<Control-g>'     => \&keyboard_g);
$top -> bind('<Control-h>'     => \&show_hint);
$top -> bind('<Control-i>'     => \&import_atoms);
$top -> bind('<Control-j>'     => \&keyboard_down);
$top -> bind('<Alt-j>'         => \&keyboard_alt_j);
$top -> bind('<Control-k>'     => \&keyboard_up);
$top -> bind('<Alt-k>'         => \&keyboard_alt_k);
$top -> bind('<Control-l>'     => sub{$list->focus});
$top -> bind('<Control-m>'     => sub{pod_display("artemis.pod")});
$top -> bind('<Control-n>'     => \&rename_this);
$top -> bind('<Control-o>'     => \&open_file);
$top -> bind('<Control-p>'     => sub{
	       if ($is_windows) {
		 Error("Print from the plot window instead.");
	       } else {
		 &replot('print')
	       }});
$top -> bind('<Control-q>'     => \&quit_artemis);
$top -> bind('<Control-r>'     => sub{&read_feff(0)});
$top -> bind('<Control-s>'     => sub{&save_project(0,0)});
$top -> bind('<Control-t>'     =>
	     sub {
	       ($current =~ /feff\d+\.\d+$/) ?
		 $widgets{path_include} -> invoke() :
		   Echo('Control-t toggles a path for including in the fit.');
	     });
$top -> bind('<Control-u>'     => \&deselect_all);
##$top -> bind('<Control-w>'     => sub{generate_script(0)});
$top -> bind('<Control-w>'     => sub {
	       my $dialog =
		 $top -> Dialog(-bitmap         => 'questhead',
				-text           => "Save this project before closing?.",
				-title          => 'Artemis: Question...',
				-buttons        => ['Save', 'Just close it', 'Cancel'],
				-default_button => 'Save',
				-font           => $config{fonts}{med},
				-popover        => 'cursor');
	       &posted_Dialog;
	       my $response = $dialog->Show();
	       Echo("Not closing project."), return if $response eq 'Cancel';
	       save_project(0,0) if $response eq 'Save';
	       delete_project(0);
	       Echo("Closed project");
	     });
$top -> bind('<Control-y>'	   => \&gds2_keyboard_type);
$top -> bind('<Control-period>'	   => \&cursor);
$top -> bind('<Control-semicolon>' => \&keyboard_plot);
$top -> bind('<Control-equal>'	   => \&zoom);
$top -> bind('<Control-minus>'	   => sub{&replot('replot')});
$top -> bind('<Shift-Alt-d>'	   => \&dump_paths);


## top level widget for displaying verious interactions
my $update = $top -> Toplevel(-class=>'horae');
$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},);
$top -> bind('<Control-Key-1>' => sub{raise_palette('ifeffit')   } );
$top -> bind('<Control-Key-2>' => sub{raise_palette('results')   } );
$top -> bind('<Control-Key-3>' => sub{raise_palette('files')     } );
$top -> bind('<Control-Key-4>' => sub{raise_palette('messages')  } );
$top -> bind('<Control-Key-5>' => sub{raise_palette('echo')      } );
$top -> bind('<Control-Key-6>' => sub{raise_palette('journal')   } );
$top -> bind('<Control-Key-7>' => sub{raise_palette('properties')} );

## $top -> bind('<Control-e>' => sub{print "doing something bad ... \n";
## 				  &foo;
## 				});

## ============================================================================
## ============================================================================
## arrays of commonly used widget arguments
my @button_list    = (-foreground       => $config{colors}{activebackground},
		      -activeforeground => $config{colors}{activebackground},
		      -background       => $config{colors}{button},
		      -activebackground => $config{colors}{activebutton},
		      -font             => $config{fonts}{bold},);
my @button2_list   = (-foreground       => $config{colors}{button},
		      -activeforeground => $config{colors}{button},
		      -background       => $config{colors}{background},
		      -activebackground => $config{colors}{activebackground},
		      -font             => $config{fonts}{smbold},);
my @button3_list =   (-foreground       => $config{colors}{button},
		      -activeforeground => $config{colors}{button},
		      -background	=> $config{colors}{background2},
		      -activebackground	=> $config{colors}{activebackground2});
my @fitbutton_list = (-foreground       => $config{colors}{activebackground},
		      -activeforeground => $config{colors}{activebackground},
		      -background       => $config{colors}{fitbutton},
		      -activebackground => $config{colors}{activefitbutton},
		      -font             => $config{fonts}{bold},);
my @menu_args      = (-foreground       => $config{colors}{foreground},
		      -background       => $config{colors}{background},
		      -activeforeground => $config{colors}{activebutton},
		      );
		      #-font => $config{fonts}{small}, );
my @menu_header_args = (-foreground	  =>'grey20',
			-activeforeground =>'grey20',
			-font		  =>$config{fonts}{smbold}, );
my @title          = (-fill       => $config{colors}{activehighlightcolor},
		      -font       => $config{fonts}{bignbold});
my @title2         = (-foreground => $config{colors}{activehighlightcolor},
		      -font       => $config{fonts}{bignbold});
my @window_size    = (-width      => $config{geometry}{main_width}.'c',
		      -height     => $config{geometry}{main_height}.'c');


## ============================================================================
## ============================================================================
## menubar
## my $menubar = $top -> Frame(-relief=>'ridge', -borderwidth=>2)
##    -> pack(-side=>"top", -anchor=>'nw', -fill=>'x');
splash_message("Creating projectbar and menus");
$top -> configure(-menu=> my $menubar = $top->Menu(-relief=>'ridge'));


## ============================================================================
## ============================================================================
## projectbar
my $projectbar = $top -> Frame(-relief=>'flat', -borderwidth=>2);
$projectbar -> Label(-text=>'Current project: ', -font=>$config{fonts}{bold},
		     -foreground=>$config{colors}{button})
  -> pack(-side=>'left', -padx=>4);
my $project_label;
if ($config{general}{projectbar} eq 'file') {
  $project_label = $projectbar -> Label(-textvariable => \$project_name,
					-font	      => $config{fonts}{med},
					-relief	      => 'flat',
					-anchor	      => 'e')
    -> pack(-side=>'left');
} elsif ($config{general}{projectbar} eq 'title') {
  $project_label = $projectbar -> Label(-textvariable => \$props{'Project title'},
					-font	      => $config{fonts}{med},
					-relief	      => 'flat',
					-anchor	      => 'e')
    -> pack(-side=>'left');
};
$widgets{project_modified} = $projectbar -> Label(-text=>'',
						  -width=>9,
						  -relief=>'groove',
						  -font=>$config{fonts}{small},)
   -> pack(-side=>'right', -padx=>2);
my @hilite = (-foreground => $config{colors}{highlightcolor},
	      -background => $config{colors}{activebackground},
	      -cursor     => $mouse_over_cursor,);
my @normal = (-foreground => $config{colors}{foreground},
	      -background => $config{colors}{background});
$widgets{project_modified} -> bind("<ButtonPress-1>", sub{&save_project(0,0) unless $project_saved});
$widgets{project_modified} -> bind("<ButtonPress-2>", sub{&save_project(0,0) unless $project_saved});
$widgets{project_modified} -> bind("<ButtonPress-3>", sub{&save_project(0,0) unless $project_saved});
$widgets{project_modified} -> bind("<Any-Enter>",     sub{$widgets{project_modified}->configure(@hilite) unless $project_saved});
$widgets{project_modified} -> bind("<Any-Leave>",     sub{$widgets{project_modified}->configure(@normal)});
$projectbar -> pack(-side=>"top", -anchor=>'nw', -fill=>'x')
  unless ($config{general}{projectbar} eq 'none');

## ============================================================================
## ============================================================================
## File menu
my $save_index = 10; # data  all_paths (+1)  selected (+3)
my $file_menu = $menubar
  -> cascade(-label=>'~File', @menu_args,
	     -menuitems=>[[ command => 'Open file', -accelerator => 'Ctrl-o',
			    -command => \&open_file],
			  [ cascade => 'Recent files', -tearoff=>0,
			    -menuitems=>[]],
			  [ cascade => 'Project data', -tearoff=>0,
			    -menuitems => [
					   [ command => 'Import project data', @menu_args,
					     -command => sub{dispatch_read_data(0, "", 1)}],
					     ##-command => sub{dispatch_read_data($paths{$current}->data, "", 1)}],
					   [ command => 'Transfer many data files', @menu_args,
					     -command => \&bulk_data],
					  ]],
			  "-",
			  [ command =>'Convert a feffit input file',
			    -state => ($config{general}{import_feffit}) ? 'normal' : 'disabled',
			    -command=>\&feffit_convert_input],
			  "-",
			  [ command =>'Save project', -accelerator => 'Ctrl-s',
			    -command => [\&save_project, 0, 0]],
			  [ command =>'Save project as ...',
			    -command => [\&save_project, 1, 0]],
			  "-",
			  [ cascade => 'Save data as ...', -tearoff=>0,
			    -state   =>'disabled',
			    -menuitems => [[ command=>'chi(k)', @menu_args,
					     -command=>[\&save_data, 'data', 'k']],
					   [ command=>'chi(R)', @menu_args,
					     -command=>[\&save_data, 'data', 'r']],
					   [ command=>'chi(q)', @menu_args,
					     -command=>[\&save_data, 'data', 'q']]]
			  ],
			  [ cascade => 'Save fit as ...', -tearoff=>0,
			    -state   =>'disabled',
			    -menuitems => [[ command=>'chi(k)', @menu_args,
					     -command=>[\&save_fit, 'fit',  'k']],
					   [ command=>'chi(R)', @menu_args,
					     -command=>[\&save_fit, 'fit',  'r']],
					   [ command=>'chi(q)', @menu_args,
					     -command=>[\&save_fit, 'fit',  'q']]]
			  ],
			  [ cascade => 'Save background as ...', -tearoff=>0,
			    -state   =>'disabled',
			    -menuitems => [[ command=>'chi(k)', @menu_args,
					     -command=>[\&save_fit, 'bkg',  'k']],
					   [ command=>'chi(R)', @menu_args,
					     -command=>[\&save_fit, 'bkg',  'r']],
					   [ command=>'chi(q)', @menu_args,
					     -command=>[\&save_fit, 'bkg',  'q']]]
			  ],
			  [ cascade => 'Save residual as ...', -tearoff=>0,
			    -state   =>'disabled',
			    -menuitems => [[ command=>'chi(k)', @menu_args,
					     -command=>[\&save_fit, 'res',  'k']],
					   [ command=>'chi(R)', @menu_args,
					     -command=>[\&save_fit, 'res',  'r']],
					   [ command=>'chi(q)', @menu_args,
					     -command=>[\&save_fit, 'res',  'q']]]
			  ],
			  [ cascade => 'Save ALL paths as ...', -tearoff=>0,
			    -state   =>'disabled',
			    -menuitems => [[ command=>'chi(k)', @menu_args,
					     -command=>[\&save_all_paths, 'k']],
					   [ command=>'chi(R)', @menu_args,
					     -command=>[\&save_all_paths, 'R']],
					   [ command=>'chi(q)', @menu_args,
					     -command=>[\&save_all_paths, 'q']]]
			  ],
			  "-",
			  [cascade => "Save selected groups as", -tearoff=>0,
			   -state  =>'disabled',
			   -menuitems=>[
					[ command=>"chi(k)", @menu_args,
					  -command=>[\&save_selected, 'k']],
					[ command=>"k*chi(k)", @menu_args,
					  -command=>[\&save_selected, 'k1']],
					[ command=>"k^2*chi(k)", @menu_args,
					  -command=>[\&save_selected, 'k2']],
					[ command=>"k^3*chi(k)", @menu_args,
					  -command=>[\&save_selected, 'k3']],
					"-",
					[ command=>"|chi(R)|", @menu_args,
					  -command=>[\&save_selected, 'rm']],
					[ command=>"Re[chi(R)]", @menu_args,
					  -command=>[\&save_selected, 'rr']],
					[ command=>"Im[chi(R)]", @menu_args,
					  -command=>[\&save_selected, 'ri']],
					"-",
					[ command=>"|chi(q)|", @menu_args,
					  -command=>[\&save_selected, 'qm']],
					[ command=>"Re[chi(q)]", @menu_args,
					  -command=>[\&save_selected, 'qr']],
					[ command=>"Im[chi(q)]", @menu_args,
					  -command=>[\&save_selected, 'qi']],
				       ]],
			  "-",
			  [ command =>'Close project', -accelerator => 'Crtl-w',
			    -command => sub {
			      my $dialog =
				$top -> Dialog(-bitmap         => 'questhead',
					       -text           => "Save this project before closing?.",
					       -title          => 'Artemis: Question...',
					       -buttons        => ['Save', 'Just close it', 'Cancel'],
					       -default_button => 'Save',
					       -font           => $config{fonts}{med},
					       -popover        => 'cursor');
			      &posted_Dialog;
			      my $response = $dialog->Show();
			      Echo("Not closing project"), return if $response eq 'Cancel';
			      save_project(0,0) if $response eq 'Save';
			      delete_project(0);
			      Echo("Closed project.");
			    }],
			  [ command =>'Quit', -accelerator => 'Ctrl-q',
			    -command=>\&quit_artemis]
			 ]);
#  -> pack(-side=>'left');

## ============================================================================
## ============================================================================
## edit menu
my $edit_menu = $menubar
  -> cascade(-label=>'~Edit', @menu_args,
	     -menuitems=>[
			  [ command => "Write Ifeffit script",
			   -command => [\&generate_script, 0]],
			  "-",
			  [ command => "Display Ifeffit buffer", -accelerator => 'Ctrl-1',
			   -command => sub{raise_palette('ifeffit');}],
			  [ command => "Display fit results", -accelerator => 'Ctrl-2',
			   -command => sub{raise_palette('results');}],
			  [ command => "View files", -accelerator => 'Ctrl-3',
			   -command => sub{raise_palette('files');}],
			  [ command => "View messages", -accelerator => 'Ctrl-4',
			   -command => sub{raise_palette('messages');}],
			  [ command => "Display echo buffer", -accelerator => 'Ctrl-5',
			   -command => sub{raise_palette('echo');}],
			  [ command => "Write in journal", -accelerator => 'Ctrl-6',
			   -command => sub{raise_palette('journal');}],
			  [ command => "Edit project properties", -accelerator => 'Ctrl-7',
			   -command => sub{raise_palette('properties');}],
			  "-",
			  [ command => "Compact project",
			   -command => \&compactify_project],
			  "-",
			  [ command => 'Edit preferences',
			   -command => \&prefs],
			 ]);
#  -> pack(-side=>'left');


## ============================================================================
## ============================================================================
## show menu
## my $show_menu = $menubar -> cascade(-label=>'Show', @menu_args,);
## #  -> pack(-side=>'left');
## $show_menu -> AddItems([ command=>"Show groups",
## 			-command=>[\&show_things, 'groups']],
## 		       #[ command=>"Show paths",
## 		       # -command=>[\&show_things, 'paths']],
## 		       [ command=>'Show this path', -state=>'disabled',
## 			-command=>\&show_path],
## 		       [ command=>"Show variables",
## 			-command=>[\&show_things, 'variables']],
## 		       [ command=>"Show def variables",
## 			-command=>[\&show_defs]],
## 		       [ command=>"Show scalars",
## 			-command=>[\&show_things, 'scalars']],
## 		       [ command=>"Show arrays",
## 			-command=>[\&show_things, 'arrays']],
## 		       [ command=>"Show strings",
## 			-command=>[\&show_things, 'strings']],
## 		       #[ command=>"Show all",
## 		       # -command=>[\&show_things, 'all']],
## 		       "-",
## 		       [ command=>"Show project folder",
## 			-command=>sub{Echo("Project folder: $project_folder")}],
## 		      );
##



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

$menubar -> separator;


## ============================================================================
## ============================================================================
## gsd menu
my $gsd_menu = $menubar
  -> cascade(-label=>'~GDS', @menu_args,
	     -menuitems=>[[ command => 'Grab all best fit values',
			    -command => \&grab_all_best_fits],
			  [ command => 'Annotate selected parameter',
			    -command => \&gds2_annotation],
			  [ command => 'Locate parameter',
			    -command => \&gds2_locate],
			  [ command => 'Show all parameters',
			    -command => \&gds2_show],
			  [ command => 'Reset all variables',
			    -command => \&reset_all_variables],
			  [ command => 'Convert all guesses to sets',
			    -command => \&gds2_guess_to_set],
			  [ command => 'Discard all variables',
			    -command => \&clear_all_variables],
			  "-",
			  [ command => 'Highlight parameters matching ...',
			    -command => \&gds2_highlight],
			  [ command => 'Clear parameter highlights',
			    -command => \&gds2_clear_highlights],
			  "-",
			  [ command => 'Import variables from text file',
			    -command => \&gds2_import_text],
			  [ command => 'Export variables to text file',
			    -command => \&gds2_export_text],
			  "-",
			  [ command => 'How many independent points?',
			    -command => \&nidp],
			  [ cascade => 'Quick help',
			   -tearoff => 0,
			   -menuitems => [
					  [ command => 'guess',
					   -command => [\&Echo, "Guesses are varied to best fit the data; math expressions are written in terms of them"]],
					  [ command => 'def',
					   -command => [\&Echo, "A def parameter's math expression is stored and updated througout a fit"]],
					  [ command => 'set',
					   -command => [\&Echo, "A set parameter is a math expression which is evaluated at the time of definition"]],
					  [ command => 'skip',
					   -command => [\&Echo, "A skip parameter is ignored by Artemis but retained in the project"]],
					  [ command => 'restrain',
					   -command => [\&Echo, "A restrain parameter is a math expression which is evaluated and added to chi-square during the fit"]],
					  [ command => 'after',
					   -command => [\&Echo, "An after parameter is a math expression which is evaluated after the fit and written to the log"]],
					 ]],
			 ]);
#  -> pack(-side=>'left');

## ============================================================================
## ============================================================================
## data menu
my $data_menu = $menubar
  -> cascade(-label=>'~Data', @menu_args,
	     -menuitems=>[[ command => 'Fit',
			   -command => [\&generate_script, 1]],
			  ##[ cascade => "Sum of paths (this data set) ...", -tearoff=>0,
			  ## -menuitems=>[[ command => 'All inlcuded paths', @menu_args,
			  ##		 -command => [\&generate_script, 2]],
			  ##		[ command => 'Selected & included paths', @menu_args,
			  ##	         -command => [\&generate_script, 2, 'selected, included']],
			  ##		[ command => 'All selected paths', @menu_args,
			  ##	         -command => [\&generate_script, 2, 'all selected']],
			  ##	       ]],
			  ##[ command => 'Automated first shell fit',
			  ## -state   => 'disabled',
			  ## -command => [\&firstshell, 1]],
			  [ command => 'Save background subtracted as chi(k)',
			   -command => \&save_bkgsub_data,
			   -state   => 'disabled',],
			  [ command => 'Make difference spectra using selected paths',
			   -command => \&make_difference_spectrum],
			  "-",
			  [ cascade   => 'Clone a FEFF calculation ...',
			   -tearoff   => 0,
			   -menuitems =>[
					 [ command => 'link',
					  -command => [\&clone_feff, 'link']],
					 [ command => 'copy',
				          -command => [\&clone_feff, 'copy']],
					]],
			  #[ command => 'Change this data file',
			  #  -command => \&renew_data], #dispatch_read_data],
			  [ command => 'Rename these data', -accelerator=>'Ctrl-n',
			   -command => \&rename_data],
			  [ command => 'View this data file',
			   -command => [\&display_file, 'data', 'this']],
			  [ command => 'Restore default parameter values',
			   -command => [\&restore_default, 'all']],
			  "-",
			  [ command => 'Discard this data set',
			   -command => \&delete_data],
			  "-",
			  [ command => 'What is epsilon_k?',
			   -command => \&fetch_epsilon_k],
			  [ command => 'How many independent points?',
			   -command => \&nidp],
			 ]);
#  -> pack(-side=>'left');

my $sum_menu = $menubar
  -> cascade(-label=>'Sum', @menu_args, -underline=>1,
	     -menuitems=>[[ command => 'All included paths for this data set', @menu_args,
			    -command => [\&generate_script, 2]],
			  [ command => 'Selected & included paths for this data set', @menu_args,
			    -command => [\&generate_script, 2, 'selected, included']],
			  [ command => 'All selected paths for this data set', @menu_args,
			    -command => [\&generate_script, 2, 'all selected']],
			 ]);

my $fit_menu = $menubar
  -> cascade(-label=>'Fits', @menu_args, -underline=>1,
	     -menuitems=>[[ command => "Restore this fit model",
			   -command => \&logview_restore_model,
			   -state => 'disabled'],
			  "-",
			  [ cascade   => 'Save data + this fit, residual (bkg) as ...',
			   -tearoff   => 0,
			   -menuitems =>[
					 [ command =>'chi(k)', @menu_args,
					  -command =>[\&save_full_data, 'k']],
					 "-",
					 [ command =>'|chi(R)|', @menu_args,
					  -command =>[\&save_full_data, 'r_mag']],
					 [ command =>'Re[chi(R)]', @menu_args,
					  -command =>[\&save_full_data, 'r_re']],
					 [ command =>'Im[chi(R)]', @menu_args,
					  -command =>[\&save_full_data, 'r_im']],
					 "-",
					 [ command =>'|chi(q)|', @menu_args,
					  -command =>[\&save_full_data, 'q_mag']],
					 [ command =>'Re[chi(q)]', @menu_args,
					  -command =>[\&save_full_data, 'q_re']],
					 [ command =>'Im[chi(q)]', @menu_args,
					  -command =>[\&save_full_data, 'q_im']],
					],
			  ],
			  [ command => 'Rename this fit',
			   -accelerator=>'Ctrl-n',
			   -command =>\&rename_fit ],
			  [ cascade   => 'This fit\'s comment ...',
			   -tearoff   => 0,
			   -menuitems => [
					  [ command => "Show",
					    -command =>\&logview_show_comment ],
					  [ command => "Change",
					    -command =>\&logview_change_comment ],
					 ],
			  ],
			  [ cascade   => 'This fit\'s figure of merit ...',
			   -tearoff   => 0,
			   -menuitems => [
					  [ command => "Show",
					    -command =>\&logview_show_fom ],
					  [ command => "Change",
					    -command =>\&logview_change_fom ],
					 ],
			  ],
			  [ command => "Show warnings from this fit",
			   -command => \&display_warnings,
			  ],
			  [ cascade => "Plot running R-factor ...", -tearoff=>0,
			   -state   => 'disabled',
			   -menuitems => [[ command=>"computed in k", @menu_args,
					   -command=>[\&running_r_factor, 'k']],
					  [ command=>"computed in R", @menu_args,
					   -command=>[\&running_r_factor, 'r']],
					  [ command=>"computed in q", @menu_args,
					   -command=>[\&running_r_factor, 'q']]]],
			  #"-",
			  #[ command => "Hide this fit",
			  # -command => \&hide_fit],
			  #[ command => "Hide selected fits",
			  # -command => \&hide_selected_fits],
			  #[ command => "Show all fits",
			  # -command => \&show_fits],
			  "-",
			  [ command => "Discard this fit",
			   -command => \&discard_fit],
			  [ command => "Discard selected fits",
			   -command => \&discard_selected_fits],
			  [ command => "Discard all fits",
			   -command => \&discard_all_fits],
			  "-",
			  [ checkbutton => "Make new entry for each fit",
			   -selectcolor => $config{colors}{check},
			   -variable    => \$fit{new},
			   -onvalue     => 1,
			   -offvalue    => 0,],
			  [ checkbutton => "Show fit information dialog",
			   -selectcolor => $config{colors}{check},
			   -variable    => \$config{general}{fit_query},
			   -onvalue     => 1,
			   -offvalue    => 0,],
			 ]);

## ============================================================================
## ============================================================================
## FEFF Menu
my $feff_menu = $menubar
  -> cascade(-label=>'~Theory', @menu_args,
	     -menuitems=>[[ command => "New Atoms page",
			   -command => \&new_atoms],
			  [ command => "New Feff input template",
			   -command => \&feff_template],
			  [ command => "Quick first shell theory",
			   -command => [\&firstshell, 0]],
			  "-",
			  [ command => "Add a feff path",
			   -command => [\&read_feff, '^^']], #\&add_a_path],
			  [ command => 'Rename this FEFF calculation',
			   -accelerator=>'Ctrl-n',
			   -command => \&rename_feff],
			  [ cascade => "View ...", -tearoff=>0,
			    -menuitems=>[[ command => "log of Feff run", @menu_args,
					   -command => [\&display_file, 'feff', 'feff.run']],
					 [ command => "misc.dat", @menu_args,
					   -command => [\&display_file, 'feff', 'misc.dat']],
					 [ command => "files.dat", @menu_args,
					   -command => [\&display_file, 'feff', 'files.dat']],
					 [ command => "paths.dat", @menu_args,
					   -command => [\&display_file, 'feff', 'paths.dat']],
					]],
			  [ cascade => 'Set path degeneracies ...', -tearoff=>0,
			    -menuitems => [
					   [ command => 'to 1', @menu_args,
					     -command => [\&set_degeneracy, 1]],
					   [ command => 'to FEFF', @menu_args,
					     -command => [\&set_degeneracy, 'feff']],
					  ]],
			  "-",
			  [ command => "Atoms", @menu_header_args],
			  [ command => "  Space group browser",
			   -command => \&post_sgb ],
			  [ cascade => '  Write special output', -tearoff=>0,],
			  [ command => "  Clear Atoms page",
			   -command => \&clear_atoms ],
			  "-",
			  [ command => 'Discard this FEFF calculation',
			   -command => [\&delete_feff,0,0],
			   -state   => 'disabled'],
			  "-",
			  [ command => 'Identify this FEFF calculation',
			   -command => \&identify_feff, -state=>'disabled'],
			 ]);
#  -> pack(-side=>'left');
&set_atp_menu;



## ============================================================================
## ============================================================================
## Paths menu
my @paths_menuitems = ([ command => 'View this feffNNNN.dat file', -state=>'disabled',
			 -command => [\&display_file, 'path', 'this']],
		       [ command => 'Show this path', -state=>'disabled',
			 -command => \&show_path],
		       [ cascade => "Save this path as ...", -tearoff=>0,
			 -state=>'disabled',
			 -menuitems=>[[ command=>"chi(k)", @menu_args,
					-command=>[\&save_data, 'path', 'k']],
				      [ command=>"chi(R)", @menu_args,
					-command=>[\&save_data, 'path', 'r']],
				      [ command=>"chi(q)", @menu_args,
					-command=>[\&save_data, 'path', 'q']]]],
		       "-",
		      );

my @add_cascade = ();
my @clear_cascade = ();
foreach (qw(label S02 E0 delR sigma^2 Ei 3rd 4th dphase k_array phase_array amp_array)) {
  push @add_cascade,   [ command=>$_, @menu_args,
		        -command=>[\&add_mathexp, $_]];
  push @clear_cascade, [ command=>$_, @menu_args,
		        -command=>[\&add_to_paths, $_, '^^clear^^', 'this']];
};
push @paths_menuitems, [ cascade => "Add math expression to each path",
			 -tearoff=>0, -menuitems=>\@add_cascade];
push @paths_menuitems, [ cascade => "Clear math expression for each path",
			 -tearoff=>0, -menuitems=>\@clear_cascade];
push @paths_menuitems, [ cascade => "Include paths for fitting", -tearoff=>0,
			-menuitems=>
			 [[ command=>"For THIS feff calculation ...", @menu_header_args],
			  [ command=>"  include all paths", @menu_args,
			   -command=>[\&select_paths, 'all,this']],
			  [ command=>"  exclude all paths after current", @menu_args,
			   -command=>[\&select_paths, 'current']],
			  [ command=>"  include only paths with N or fewer legs", @menu_args,
			   -command=>[\&select_paths, 'nlegs']],
			  [ command=>"  include only paths shorter than R", @menu_args,
			   -command=>[\&select_paths, 'r'],],
			  [ command=>"  include only paths with amplitude larger than A", @menu_args,
			   -command=>[\&select_paths, 'amp'],],
			  [ command=>"  exclude all paths", @menu_args,
			   -command=>[\&select_paths, 'none,this']],
			  [ command=>"  invert the included paths", @menu_args,
			   -command=>[\&select_paths, 'invert,this']],
			  "-",
			  [ command=>"For EACH feff calculation ...", @menu_header_args, ],
			  [ command=>"  include all paths", @menu_args,
			   -command=>[\&select_paths, 'all,each']],
			  [ command=>"  exclude all paths", @menu_args,
			   -command=>[\&select_paths, 'none,each']],
			  [ command=>"  invert the included paths", @menu_args,
			   -command=>[\&select_paths, 'invert']],
			  "-",
			  [ command=>"Include selected paths", @menu_args,
			   -command=>[\&select_paths, 'selon']],
			  [ command=>"Exclude selected paths", @menu_args,
			   -command=>[\&select_paths, 'seloff']],
			 ]];
push @paths_menuitems, [ cascade => "Discard paths", -tearoff=>0,
			 -menuitems=>
			 [[ command=>"Discard this path", @menu_args,
			   -command=>[\&delete_path, 'this']],
			  "-",
			  [ command=>"For THIS feff calculation ...", @menu_header_args,],
			  [ command=>"  discard all paths", @menu_args,
			   -command=>[\&delete_path, 'all']],
			  [ command=>"  discard all paths after current", @menu_args,
			   -command=>[\&delete_path, 'current']],
			  [ command=>"  discard all paths with more than N legs", @menu_args,
			   -command=>[\&delete_path, 'nlegs']],
			  [ command=>"  discard all paths longer than R", @menu_args,
			   -command=>[\&delete_path, 'r']],
			  [ command=>"  discard all paths with amplitude smaller than A", @menu_args,
			   -command=>[\&delete_path, 'amp']],
			  "-",
			  [ command=>"Discard selected paths", @menu_args,
			   -command=>[\&delete_path, 'sel']],
			 ]];
push @paths_menuitems, "-",
  [ command=>"Clone this feff path", -state => 'disabled',
   -command=>\&clone_this_path],
  [ command=>"Rename this path", -state => 'disabled',
   -accelerator=>'Ctrl-n',
   -command=>\&rename_this],
  [ cascade=>"Export these paths parameters ...",
   -menuitems=>[[ command => "to every path in THIS feff calculation",
		 -command => [\&copy_pps, 'this']],
		[ command => "to every path in EACH feff with THIS data set",
		 -command => [\&copy_pps, 'data']],
		[ command => "to every path in EACH feff calculation",
		 -command => [\&copy_pps, 'each']],
		[ command => "to SELECTED paths",
		 -command => [\&copy_pps, 'sel']]
	       ]
    ],
  [ command=>"Add a feff path",
   -command=>[\&read_feff, '^^']],
  "-",
  [ checkbutton=>"Extended path parameters",
   -selectcolor=>$config{colors}{check},
   -variable=>\$config{paths}{extpp},
   -command=>\&manage_extended_params];

my $paths_menu = $menubar
  -> cascade(-label=>'~Paths', @menu_args,
	     -menuitems=>\@paths_menuitems);
#  -> pack(-side=>'left');





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

## ============================================================================
## ============================================================================
## plot menu
my @plot_menuitems = (['cascade'=>'Plot in ...', -tearoff=>0,
		       -menuitems=>[['command'=>'k-space', @menu_args,
				     -command =>[\&plot, 'k', 0]],
				    ['command'=>'R-space', @menu_args,
				     -command =>[\&plot, 'r', 0]],
				    ['command'=>'q-space', @menu_args,
				     -command =>[\&plot, 'q', 0]]]],
		      ['command'=>'Select all for plotting', -accelerator => 'Ctrl-a',
		       -command =>\&select_all],
		      ['command'=>'Deselect all for plotting', -accelerator => 'Ctrl-u',
		       -command =>\&deselect_all],
		      "-",
		      ['command'=>'Zoom', -accelerator => 'Ctrl-=',
		       -command =>\&zoom], # no trailing newline!!
		      ['command'=>'Unzoom', -accelerator => 'Crtl--',
		       -command=>[\&replot, 'replot']],
		      ['command'=>'Cursor', -accelerator => 'Ctrl-.',
		       -command =>\&cursor], # no trailing newline!!
		      '-');




my %image_formats = (gif  => "GIF (landscape)",
		     vgif => "GIF (portrait)",
		     png  => "PNG (landscape)",
		     vpng => "PNG (portrait)",
		     tpng => "PNG (black background)",
		     ps	  => "B/W Postscript (landscape)",
		     cps  => "Color Postscipt (landscape)",
		     vps  => "B/W Postscript (portrait)",
		     vcps => "Color Postscipt (portrait)",);
my @format_list;
foreach my $f ( split(" ", Ifeffit::get_string('plot_devices')) ) {
  my $format = substr($f,1);	# strip the leading slash
  next if ($format =~ /null/);
  next if ($format =~ /^x/);
  next if ($format =~ /^c?gw/);
  $image_formats{$format} ||= $format;
  push @format_list, ['command' =>$image_formats{$format}, -command  =>[\&replot, $f]];
};
push @plot_menuitems, [cascade=>"Save image as ...", -tearoff=>0,
		       -menuitems=>\@format_list];


push @plot_menuitems, "-",
  ['command'=>'Print last plot',
   -accelerator => 'Ctrl-p',
   -command=>[\&replot, 'print'],
   -state=>($is_windows)?'disabled':'normal'];


my $plot_menu = $menubar -> cascade(-label=>'Plot', @menu_args, -underline=>2,
				    -menuitems=>\@plot_menuitems);
#  -> pack(-side=>'left');
(@format_list) or $plot_menu -> menu -> entryconfigure(9, -state=>'disabled');


$menubar -> separator;

## ============================================================================
## ============================================================================
## settings menu
## my $settings_menu =
##   $menubar -> cascade(-label=>"Settings", @menu_args, -underline=>0,
## 		      -menuitems => [[ command => 'Swap panels', -accelerator => 'Ctrl-/',
## 				       -state=>'disabled',
## 				       -command => \&swap_panels],
## 				     "-",
## 				     [ command => 'Edit preferences',
## 				       -command => \&prefs],
## 				    ]);


## ============================================================================
## ============================================================================
## help menu
$menubar -> cascade(-label=>"~Help", @menu_args,
		    -menuitems=>[['command'=> 'Document', -accelerator=>'Ctrl-m',
				  -command =>sub{pod_display("artemis.pod")}],
				 ['command'=>'Dump paths',
				  -command=>\&dump_paths],
				 ['command'=>'Show a hint', -accelerator => 'Ctrl-h',
				  -command =>\&show_hint],
				 ['command'=>'About Ifeffit',
				  -command =>sub{Echo($About_Ifeffit)}],
				 ['command'=>'About Artemis',
				  -command =>sub{Echo($About)}]
				]
		   );



## ============================================================================
## ============================================================================
## set up the echo area
splash_message("Creating 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},
			  #-background => 'green',
			  -text=> "Using Ifeffit ".Ifeffit::get_string("\$&build"))
  -> pack(-side=>'left', -fill=>'x');
$echo -> bind('<KeyPress>' => sub{$multikey = $Tk::event->K; });




splash_message("Creating layout");
## ============================================================================
## ============================================================================
## main panel (fat) (operational/path parameters)
my $fat = $top -> Frame(-relief=>'sunken', -borderwidth=>2,)# @window_size)
  -> pack(-fill=>'both', -expand=>1);

## ============================================================================
## ============================================================================
## skinny panel with path list
my $skinny = $top -> Frame(-relief=>'sunken', -borderwidth=>2);

## ============================================================================
## ============================================================================
## plot controls panel
my $skinny2 = $top -> Frame(-relief=>'sunken', -borderwidth=>2);

&layout; # layout panels in user-selected order

## fit and ff2chi buttons
my $fitbar = $skinny2 ->  Frame(-relief=>'ridge', -borderwidth=>2)
   -> pack(-anchor=>'nw', -fill=>'x');
my $fit_button = $fitbar -> Button(-width=>1, @fitbutton_list,)
  -> pack(-side=>'left', -expand=>1, -fill=>'x');
&set_fit_button('disable');
## my $ff2chi_button = $fitbar -> Button(-text=>'ff2chi', -width=>1, @fitbutton_list,
## 				      -command=>[\&generate_script, 2])
##   -> pack(-side=>'left', -expand=>1, -fill=>'x');

my $lab = $skinny -> Label(-text       => 'Data & Paths',
			   -font       => $config{fonts}{smbold},
			   -foreground => $config{colors}{activehighlightcolor},
			   -justify    => 'center',
			   -relief     => 'raised')
  -> pack(-fill => 'x', -anchor=>'n');

$list = $skinny -> Scrolled('Tree',
			    -separator	      => '.',
			    -selectmode	      => 'extended',
			    #-width	      => 30,
			    -height	      => 1,
			    -indent	      => 20,
			    -scrollbars	      => 'se',
			    -itemtype	      => 'imagetext',
			    -font	      => $config{fonts}{med},
			    -selectbackground => $config{colors}{current},
			    -browsecmd	      => [\&display_properties, Ev('b')],
			    -indicatorcmd     => \&hide_branch,
			   )
  -> pack(qw/-expand 1 -fill both -anchor n -side top/);
BindMouseWheel($list);
$list->bind('<ButtonPress-2>',\&anchor_display);
$list->bind('<ButtonPress-3>', [\&list_mouse_menu, Ev('X'), Ev('Y')]);
$list->bind('<Control-ButtonPress-3>', [\&list_mouse_menu, Ev('X'), Ev('Y')]);


$skinny2 -> Label(-text=>'Plot selected groups in',
		  -font=>$config{fonts}{smbold},
		  -foreground=>$config{colors}{foreground},
		  -justify=>'center', -relief=>'raised')
  ->pack(-fill => 'x', -side => 'top');
my $plotbar = $skinny2 ->  Frame(-relief=>'ridge', -borderwidth=>2)
   -> pack(-anchor=>'nw', -fill=>'x');
my $plotq_button = $plotbar -> Button(-text=>'q', @button_list,
				      -command=>[\&plot, 'q', 0])
  -> pack(-side=>'right', -expand=>1, -fill=>'x');
my $plotr_button = $plotbar -> Button(-text=>'R', @button_list,
				      -command=>[\&plot, 'r', 0])
  -> pack(-side=>'right', -expand=>1, -fill=>'x');
my $plotk_button = $plotbar -> Button(-text=>'k', @button_list,
				      -command=>[\&plot, 'k', 0])
  -> pack(-side=>'right', -expand=>1, -fill=>'x');






## ============================================================================
## ============================================================================
## Setup the toplevel window for various textual interactions,
## including the ifeffit buffer and the raw text edit
splash_message("Creating palettes");
$update -> title("Artemis palettes");
$update -> bind('<Control-q>' => sub{$update->withdraw});
foreach my $n (qw(ifeffit results files messages echo journal properties)) {
  $notecard{$n} = $notebook -> add($n, -label=>ucfirst($n), -anchor=>'center', -underline=>0);
  my $topbar   = $notecard{$n} -> Frame(-relief=>'flat', -borderwidth=>2)
    -> pack(-expand=>0, -fill=>'x');
  $topbar  -> Button(-text=>'Dismiss', -command=>sub{$update->withdraw}, @button2_list)
    -> pack(-side=>'right');
  $labels{$n} = $topbar -> Label(-foreground=>$config{colors}{activehighlightcolor},
				 -font=>$config{fonts}{large})
    -> pack(-side=>'left', -fill=>'x');
  my $h;
 SWITCH: {
    $h = 13, last SWITCH if ($n eq 'ifeffit');
    $h = 15, last SWITCH if ($n eq 'results');
    $h = 13, last SWITCH if ($n eq 'files');
    $h = 15, last SWITCH if ($n eq 'messages');
    $h = 15, last SWITCH if ($n eq 'echo');
    $h = 15, last SWITCH if ($n eq 'journal');
    $h = 13;
  };
  if ($n eq 'properties') {
    my $frame = $notecard{$n} -> Scrolled("Pane",
					  -relief=>'flat',
					  -borderwidth=>2,
					  -scrollbars=>"oe",
					 )
      -> pack(-expand=>1, -fill=>'both', -side=>'top');
    $frame -> Subwidget("yscrollbar")
      -> configure(-background=>$config{colors}{background},
		   ($is_windows) ? () : (-width=>8));
    my $r = 0;
    foreach ('Project title', 'Comment', 'Prepared by', 'Contact') {
      my $subfr = $frame -> Frame(-relief=>'groove',
				  -borderwidth=>2,)
	-> pack(-fill=>'x', -expand=>1, -side=>'top');
      $subfr -> Label(-text	  => "$_:",
		      -width	  => 20,
		      -anchor	  => 'e',
		      -foreground => $config{colors}{activehighlightcolor})
	-> pack(-side=>'left', -anchor=>'e', -padx=>4);
      $subfr -> Entry(-width        => 0,
		      -textvariable => \$props{$_},
		     )
	-> pack(-side=>'right', -anchor=>'w', -fill=>'x', -expand=>1);
    };
    $props{'Project title'} = "<insert a title for your project here>";
    $props{'Comment'} = q{};
    $props{'Prepared by'} = "<insert your name and/or the name of your computer here>";
    $props{'Information content'} = q{};
    $props{'Project location'} = q{};
    #$props{'Prepared by'} = ($is_windows) ? "<insert your name and/or the name of your computer here>" :
    #  join("\@", $ENV{USER}||"you", $ENV{HOST}||"your.computer");
    $props{Contact} = "<insert your email address and/or phone number here>";
    foreach ('Started', 'Last fit', 'Environment', 'Project location', 'Information content') {
      my $subfr = $frame -> Frame(-relief=>'groove',
				  -borderwidth=>2,)
	-> pack(-fill=>'x', -expand=>1, -side=>'top');
      $subfr -> Label(-text	  => "$_:",
		      -width	  => 20,
		      -anchor	  => 'e',
		      -foreground => $config{colors}{activehighlightcolor})
	-> pack(-side=>'left', -anchor=>'e', -padx=>4);
      $subfr -> Entry(-width		  => 0,
		      -textvariable	  => \$props{$_},
		      -state		  => 'disabled',
		      -foreground	  => $config{colors}{foreground},
		      (($Tk::VERSION > 804) ? (-disabledforeground => $config{colors}{foreground},) : ()),
		      -relief		  => 'flat',
		 )
		 #-font=>(($_ eq 'Environment') or ($_ eq 'Information content'))
		 #? $config{fonts}{small} : $config{fonts}{med})
	  -> pack(-side=>'right', -anchor=>'w', -fill=>'x');
    };
  } else {
    my $which = ($n eq 'journal') ? 'Text' : 'ROText';
    $notes{$n}    = $notecard{$n} -> Scrolled($which,
					      -relief	   => 'sunken',
					      -borderwidth => 2,
					      -wrap	   => 'none',
					      -scrollbars  => 'se',
					      -width	   => 7,
					      -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});
    $notes{$n}   -> Subwidget("yscrollbar")
      -> configure(-background=>$config{colors}{background},
		   ($is_windows) ? () : (-width=>8));
    $notes{$n}   -> Subwidget("xscrollbar")
      -> configure(-background=>$config{colors}{background},
		   ($is_windows) ? () : (-width=>8));
    &disable_mouse3($notes{$n}->Subwidget(lc($which)));
    $notes{$n} -> bind("<Control-a>" => sub{$notes{$n}->selectAll;
					    $notes{$n}->break;});
  };
 SWITCH: {
    ($n =~ /results/) and do {
      $widgets{results_save} =
	$topbar -> Button(-text=>'Save', @button2_list, -state=>'disabled',
			  -command=>sub{
			    my $fname = 'artemis.log';
			    if ($project_name) {
			      ($fname = basename($project_name)) =~ s/apj$/log/;
			      ($fname .= ".log") unless ($fname =~ /.log$/);
			    };
			    &save_from_palette('results', $fname,
					       'Artemis: Saving results to a log file',
					       ['Artemis results', '.log'],
					       "", "")})
	  -> pack(-side=>'right');
      $widgets{results_choose} =
	$topbar -> Optionmenu(-options=>[["Raw log file"      => 'raw'],
					 ["Quick view"        => 'quick'],
					 ["Column view"       => 'column'],
					 ["Operational view"  => 'operational'],
					],
			      -variable=>\$log_type[1],
			      -textvariable=>\$log_type[0],
			      -command=>sub{log_file_display()},
			      -state=>'disabled')
	  -> pack(-side=>'right');
      last SWITCH;
    };
    ($n =~ /ifeffit/) and do {
      $widgets{ifeffit_save} =
	$topbar -> Button(-text=>'Save buffer to file', @button2_list,
			  -command=>sub{&save_from_palette('ifeffit', 'ifeffit.buffer',
							   'Artemis: Saving ifeffit buffer to a file',
							   ['Ifeffit buffer', '.buffer'],
							   "# Artemis version $Ifeffit::Path::VERSION\n" .
							   $paths{data0}->project_header($project_folder),
							   "")})
	  -> pack(-side=>'right');
      last SWITCH;
    };
    ($n =~ /files/) and do {
      $widgets{files_browse} =
	$topbar -> Button(-text=>'Browse', @button2_list,
			  -command=>sub{
			    my $path = $current_data_dir || cwd;
			    my $types = [['Text files', '*.txt'], ['All files', '*'],];
			    my $file = $top -> getOpenFile(-filetypes=>$types,
							   ##(not $is_windows) ?
							   ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
							   -initialdir=>$path,
							   -title => "Artemis: View a file");
			    return unless ($file);
			    my ($name, $pth, $suffix) = fileparse($file);
			    $current_data_dir = $pth;
			    &display_file('file', $file);
			  })
       -> pack(-side=>'right');
      last SWITCH;
    };
    ($n =~ /messages/) and do {
      $widgets{ifeffit_save} =
	$topbar -> Button(-text=>'Save buffer to file', @button2_list,
			  -command=>sub{&save_from_palette('messages', 'artemis.msg',
							   'Artemis: Saving Artemis\' message to a file',
							   ['Artemis message', '.msg'],
							   "# Artemis version $Ifeffit::Path::VERSION\n" .
							   $paths{data0}->project_header($project_folder),
							   "")})
	  -> pack(-side=>'right');
      last SWITCH;
    };
  };
};
$notebook->pack(-expand=>1, -fill => 'both', -side=>'left');
$labels{ifeffit} -> configure(-text=>"Ifeffit interaction buffer");
$notes{ifeffit}  -> tagConfigure ('command',  -foreground=>$config{colors}{foreground},
				  -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{files}   -> configure(-text=>"View files");
$labels{messages}-> configure(-text=>"Messages from Artemis");
$notes{messages} -> tagConfigure('absorber', -foreground=>$config{colors}{button});
$notes{messages} -> tagConfigure('angles',   -font=>$config{fonts}{fixedit}, -foreground=>$config{colors}{disabledforeground});
$notes{messages} -> tagConfigure('bold',     -font=>$config{fonts}{fixedbold}, -underline=>1);
$notes{messages} -> tagConfigure('warning',  -font=>$config{fonts}{fixedbold}, -foreground=>'red3', -background=>'white');
$notes{messages} -> tagConfigure('guess2',   -spacing1=>2, -background=>$config{colors}{background2});
$notes{messages} -> tagConfigure('guess',    -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{guess_color}, -background=>$config{colors}{background2});
$notes{messages} -> tagConfigure('def',      -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{def_color});
$notes{messages} -> tagConfigure('set',      -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{set_color});
$notes{messages} -> tagConfigure('skip',     -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{skip_color});
$notes{messages} -> tagConfigure('after',    -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{after_color});
$notes{messages} -> tagConfigure('restrain', -font=>$config{fonts}{fixedbold}, -spacing1=>1, -spacing3=>1, -foreground=>$config{gds}{restrain_color});
$labels{echo}    -> configure(-text=>"Record of all text written to the echo area");
$labels{results} -> configure(-text=>"Results from the last fit");
$notes{results}  -> tagConfigure('pathid', -font=>$config{fonts}{fixedit}, -underline=>1);
$notes{results}  -> tagConfigure('warning', -font=>$config{fonts}{fixedbold}, -foreground=>'red3', -background=>'white');
$labels{journal} -> configure(-text=>"Keep a journal of your analysis project");
$notes{journal}  -> configure(-wrap=>"word");
$notes{journal}  -> bind('<Control-s>' => sub{&save_project(0,0)});
$labels{properties} -> configure(-text=>"Properties of this project");

## set up the button bar in the files notecard
my $filesbbar = $notecard{files} -> Frame(qw/-relief flat -borderwidth 2/)
  -> pack(qw/-expand 0 -fill x/);
$filesbbar -> Label(-textvariable=>\$current_file,
		    -foreground=>$config{colors}{foreground},
		    -relief=>'groove')
  -> pack(qw/-expand 1 -fill x -side left/);
$filesbbar -> Button(-text=>'Save', @button2_list,
		     -command=>sub{&save_from_palette('files', $generic_name,
						      'Artemis: Saving to a file',
						      "",
						      "", "")})
  -> pack(qw/-expand 1 -fill x -side left/);
$filesbbar -> Button(-text=>'Clear', @button2_list,
		     -command=>sub{$notes{files}->delete(qw/1.0 end/);
				   $current_file = ''; })
  -> pack(qw/-expand 1 -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/-expand 0 -fill x/);
$cmdline -> Label(-text	      => 'Ifeffit> ',
		  -foreground => $config{colors}{activehighlightcolor},
		  -font	      => $config{fonts}{fixed},)
  -> pack(-side=>'left');
my $cmdbox = $cmdline -> Entry(-width	    => 75,
			       -relief	    => 'sunken',
			       -borderwidth => 2)
  -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
my @cmd_buffer = ("");
my $cmd_pointer = $#cmd_buffer;
$cmdbox->bind("<KeyPress-Return>",
	      sub{ $paths{data0}->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>",
	      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>",
	      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


## define various types of text for the paths list
my %list_styles = (
		   enabled      => $list->ItemStyle ('imagetext',
						     -foreground       => 'black',
						     -selectforeground => 'black',
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{current},),
		   enabled_ss   => $list->ItemStyle ('imagetext',
						     -foreground       => 'black',
						     -background       => $config{intrp}{ss},
						     -selectforeground => 'black',
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{current},),
		   enabled_col  => $list->ItemStyle ('imagetext',
						     -foreground       => 'black',
						     -background       => $config{intrp}{focus},
						     -selectforeground => 'black',
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{current},),
		   hidden       => $list->ItemStyle ('imagetext',
						     -foreground       => $config{colors}{hidden},
						     -selectforeground => $config{colors}{hidden},
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{current},),
		   noplot       => $list->ItemStyle ('imagetext',
						     -foreground       => 'black',
						     -selectforeground => 'black',
						     -font	       => $config{fonts}{noplot},
						     -selectbackground => 'yellow'),
		   disabled     => $list->ItemStyle ('imagetext',
						     -foreground       => $config{colors}{exclude},
						     -activeforeground => $config{colors}{exclude},
						     -selectforeground => $config{colors}{exclude},
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{activebackground},),
		   disabled_ss  => $list->ItemStyle ('imagetext',
						     -foreground       => $config{colors}{exclude},
						     -background       => $config{intrp}{ss},
						     -activeforeground => $config{colors}{exclude},
						     -selectforeground => $config{colors}{exclude},
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{activebackground},),
		   disabled_col => $list->ItemStyle ('imagetext',
						     -foreground       => $config{colors}{exclude},
						     -background       => $config{intrp}{focus},
						     -activeforeground => $config{colors}{exclude},
						     -selectforeground => $config{colors}{exclude},
						     -font	       => $config{fonts}{smbold},
						     -selectbackground => $config{colors}{activebackground},),
		   noplotdis    => $list->ItemStyle ('imagetext',
						     -foreground       => $config{colors}{exclude},
						     -activeforeground => $config{colors}{exclude},
						     -selectforeground => $config{colors}{exclude},
						     -font	       => $config{fonts}{noplot},
						     -selectbackground => 'yellow'),
		  );

$list -> add('gsd', -text=>'Guess, Def, Set         ', -style=>$list_styles{noplot});
$list -> setmode('gsd', 'none');
$list -> add('data0', -text=>'Data', -style=>$list_styles{enabled});
$list -> setmode('data0', 'none');
$list -> autosetmode();

$list -> add("data0.0", -text=>'Fit', -style=>$list_styles{enabled},);
$list -> setmode('data0.0', 'close');
## $list -> add("data0.1", -text=>'Residual', -style=>$list_styles{enabled},);
## $list -> setmode('data0.1', 'none');
## $list -> add("data0.2", -text=>'Background', -style=>$list_styles{enabled},);
## $list -> setmode('data0.2', 'none');
$list -> hide('entry', "data0.0");
## $list -> hide('entry', "data0.1");
## $list -> hide('entry', "data0.2");

$list->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
$list->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});


my %temp = ();
&set_temp;
sub set_temp {
  $temp{op_kwindow}  = $config{data}{kwindow};
  $temp{op_rwindow}  = $config{data}{rwindow};
  $temp{op_fitspace} = 'R';
  $temp{op_include}  = 0;
  $temp{op_plot}     = 0;
  $temp{op_do_bkg}   = 'no';
  $temp{op_pcplot}   = 'No';
  $temp{op_pcpath}   = 'None';
  $temp{op_pcpath_label}   = 'None';
  $temp{op_k1}       = 0;
  $temp{op_k2}       = 0;
  $temp{op_k3}       = 0;
  $temp{op_karb_use} = 0;
  $temp{bkg_fixstep} = 0;
  $temp{bkg_flatten} = 0;
  $temp{bkg_clamp2}  = 'None';
};

## ============================================================================
## ============================================================================


## set up error handlers
#$SIG{__DIE__} = sub{$setup->trap('Artemis',$VERSION, 'die', $trapfile, \&Error, $project_folder)};
#$SIG{__WARN__} = sub{$setup->trap("Artemis", $VERSION, "warn", $trapfile, \&Error, $project_folder)};
$SIG{__DIE__}  = sub{Carp::cluck(@_); print STDERR $/; Error("Artemis trapped one or more warnings!  Warning message dumped to screen.")};
$SIG{__WARN__} = sub{Carp::cluck(@_); print STDERR $/; Error("Artemis trapped one or more errors!  Error message dumped to screen.")};

splash_message("Setting up initial data objects");
$setup -> SetDefault(fit_space	    => $config{data}{fit_space},
		     do_bkg	    => ($config{data}{fit_bkg}) ? 'yes' : 'no',
		     kmin	    => $config{data}{kmin},
		     kmax	    => $config{data}{kmax} || 15,
		     dk		    => $config{data}{dk},
		     k1		    => ($config{data}{kweight} == 1),
		     k2		    => ($config{data}{kweight} == 2),
		     k3		    => ($config{data}{kweight} == 3),
		     rmin	    => $config{data}{rmin},
		     rmax	    => $config{data}{rmax},
		     dr		    => $config{data}{dr},
		     kwindow	    => $config{data}{kwindow},
		     rwindow	    => $config{data}{rwindow},
		     cormin	    => $config{data}{cormin},
		     nindicators    => $config{plot}{nindicators},
		     indicatorcolor => $config{plot}{indicatorcolor},
		     indicatorline  => $config{plot}{indicatorline},
		    );
$paths{data0}     = Ifeffit::Path -> new(id	 => 'data0',
					 group   => 'data0',
					 type    => 'data',
					 sameas  => 0,
					 file    => "",
					 include => 1,
					 family  => \%paths);
$paths{"data0.0"} = Ifeffit::Path -> new(id	=> "data0.0",
					 type   => 'fit',
					 group  => 'data0_fit',
					 sameas => 'data0',
					 lab    => 'Fit',
					 parent => 0,
					 family => \%paths);
## $paths{"data0.2"} = Ifeffit::Path -> new(id=>"data0.2", type=>'bkg',
## 					 group=>'data0_bkg',
## 					 sameas=>'data0', lab=>'Background',
## 					 family=>\%paths);
## $paths{"data0.1"} = Ifeffit::Path -> new(id=>"data0.1", type=>'res',
## 					 group=>'data0_res',
## 					 sameas=>'data0', lab=>'Residual',
## 					 family=>\%paths);
$paths{gsd} = Ifeffit::Path -> new(id=>'gsd', type=>'gsd', family=>\%paths);
$props{Environment} = (split(/\n/, $paths{data0} -> project_header))[1];
$props{Environment} =~ s/\# /Artemis $VERSION /;
$props{Started} = $paths{data0} -> date_of_file;


splash_message("Populating main window");
my $current_canvas = 'op';
my $opparams  = make_opparams($fat);
my $gsd       = make_gds2($fat);
my $feff      = make_feff($fat);
my $path      = make_path($fat);
my $logviewer = logviewer($fat);
map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'disabled')} (keys %widgets);
map {$grab{$_}->configure(-state=>'disabled')} (keys %grab);

$opparams -> pack();
# select and anchor the first data file and give the list initial focus
$list->Subwidget("tree")->anchorSet('data0');
$list->Subwidget("tree")->selectionSet('data0');
$list->Subwidget("tree")->focus();
$current = 'data0';

## ============================================================================
## ============================================================================
splash_message("Setting up plotting options");
$skinny2 -> Label(-text=>'Plotting options',
		  -font=>$config{fonts}{smbold},
		  -foreground=>$config{colors}{foreground},
		  -justify=>'center', -relief=>'raised')
  ->pack(-fill => 'x', -side => 'top');
my $kweights = $skinny2 -> Frame(-borderwidth=>2, -relief=>'ridge');
$kweights -> Radiobutton(-text		   => '0',
			 -selectcolor	   => $config{colors}{check},
			 -font		   => $config{fonts}{med},
			 -foreground	   => $config{colors}{activehighlightcolor},
			 -activeforeground => $config{colors}{activehighlightcolor},
			 -value		   => '0',
			 -variable	   => \$plot_features{kweight},
			 -command	   => sub{&plot($last_plot, 0)})
  -> pack(-side=>'left');
$kweights -> Radiobutton(-text		   => '1',
			 -selectcolor	   => $config{colors}{check},
			 -font		   => $config{fonts}{med},
			 -foreground	   => $config{colors}{activehighlightcolor},
			 -activeforeground => $config{colors}{activehighlightcolor},
			 -value		   => '1',
			 -variable	   => \$plot_features{kweight},
			 -command	   => sub{&plot($last_plot, 0)})
  -> pack(-side=>'left');
$kweights -> Radiobutton(-text		   => '2',
			 -selectcolor	   => $config{colors}{check},
			 -font		   => $config{fonts}{med},
			 -foreground	   => $config{colors}{activehighlightcolor},
			 -activeforeground => $config{colors}{activehighlightcolor},
			 -value		   => '2',
			 -variable	   => \$plot_features{kweight},
			 -command	   => sub{&plot($last_plot, 0)})
  -> pack(-side=>'left');
$kweights -> Radiobutton(-text		   => '3',
			 -selectcolor	   => $config{colors}{check},
			 -font		   => $config{fonts}{med},
			 -foreground	   => $config{colors}{activehighlightcolor},
			 -activeforeground => $config{colors}{activehighlightcolor},
			 -value		   => '3',
			 -variable	   => \$plot_features{kweight},
			 -command	   => sub{&plot($last_plot, 0)})
  -> pack(-side=>'left');
$kweights -> Radiobutton(-text		   => 'kw',
			 -selectcolor	   => $config{colors}{check},
			 -font		   => $config{fonts}{med},
			 -foreground	   => $config{colors}{activehighlightcolor},
			 -activeforeground => $config{colors}{activehighlightcolor},
			 -value		   => 'kw',
			 -variable	   => \$plot_features{kweight},
			 -command	   => sub{&plot($last_plot, 0)})
  -> pack(-side=>'left');

$kweights -> pack(-fill => 'x');

$widgets{plot_extra_frame} = $skinny2 -> Frame(-borderwidth=>0, -relief=>'flat');
$widgets{plot_extra} = $widgets{plot_extra_frame} -> NoteBook(-backpagecolor=>$config{colors}{background},
							      -inactivebackground=>$config{colors}{inactivebackground},
							      -font=>$config{fonts}{med}
							     )
  -> pack(-fill=>'both', -side=>'top', -expand=>1, -padx=>2, -pady=>2);
$widgets{plot_Main} = $widgets{plot_extra} -> add('main',       -label=>'Main',   -anchor=>'center');
$widgets{plot_Ind}  = $widgets{plot_extra} -> add('indicators', -label=>'Indic',  -anchor=>'center');
&setup_indicators;
$widgets{plot_Sta}  = $widgets{plot_extra} -> add('traces',     -label=>'Traces', -anchor=>'center');
&setup_stack;
## $widgets{plot_Inv}  = $widgets{plot_extra} -> add('invert',     -label=>'Inv',  -anchor=>'center');
## &setup_invert;
## $widgets{plot_extra_frame} -> Button(-text=>'Hide extra features',
## 				     @button2_list,
## 				     -command=>\&remove_extra_plot)
##   -> pack(-fill=>'x', -side=>'bottom', -padx=>2);

&set_plotoptions($widgets{plot_Main});
$widgets{plot_extra} -> raise('main');


$widgets{help_plot} =
  $skinny2 -> Button(-text=>'Document: Plotting',  @button2_list,
		     -command=>sub{pod_display("artemis_plot.pod")} )
  -> pack(-side=>'bottom', -fill=>'x', -padx=>2, -pady=>2);

$widgets{plot_extra_frame}  -> pack(-fill => 'both', -side => 'top', -expand=>1);



##my $plotsel = $skinny -> NoteBook();
my %plotcard;
## foreach (qw/k r q/) {
##   my $lab;
##   ($_ eq 'k') and ($lab = "  k  ");
##   ($_ eq 'r') and ($lab = "  R  ");
##   ($_ eq 'q') and ($lab = "  q  ");
##   $plotcard{$_} = $plotsel -> add($_, -label=>$lab, -anchor=>'center');
## };
## $plotcard{Help} = $plotsel -> add('Help', -label=>'Help', -anchor=>'center');
#&set_plotcards;
##$plotsel-> pack(-fill => 'x', -side => 'bottom');
##$plotsel -> raise('r');
#$fr -> pack(-side=>'bottom', -fill=>'x', -anchor=>'s');
#$list -> createWindow('0.1c', '18c', -anchor=>'sw', -width=>'5.3c', -window => $fr);

$list->Subwidget("tree")->anchorSet('gsd');
&display_properties;
$top -> update;





## ============================================================================
## ============================================================================
## remove splashscreen and display program
splash_message("Initializing Ifeffit");
$list->Subwidget("tree")->anchorSet('data0');
&display_properties;

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


&set_recent_menu;

splash_message("Ready to start...");
$top -> update;
$splash -> Destroy;

&clean_old_trap_files;
&initialize_project(1);

Echo($About_Ifeffit);
$top -> after(2000, [\&Echo, "Artemis may be freely redistributed under the terms of its license."]);
$top -> after(3500, [\&Echo, "Artemis comes with absolutely NO WARRANTY."]);
if ($STAR_Parser_exists) {
  $top -> after(5500, \&show_hint);
} else {
  $top -> after(5500, [\&Echo, "You cannot import CIF files because STAR::Parser is not installed."]);
};

##&bindDump($update);

## make sure that the parameters will be updated the first time a plot
## or show is done.
$parameters_changed = 1;

my $chdir_to = Cwd::cwd || $current_data_dir || dirname($0) || $ENV{IFEFFIT_DIR};
$chdir_to = Cwd::abs_path($chdir_to);
chdir $chdir_to;

delete $config{general}{devel_greetings} if (exists $config{general}{devel_greetings});
($config{general}{greetings} = "0.0.0") unless (exists $config{general}{greetings});
my $vv = sprintf("%d.%2.2d%3.3d", split(/\./, $VERSION));
my $vg = sprintf("%d.%2.2d%3.3d", split(/\./, $config{general}{greetings}));

if ($vv > $vg) {
  #   my $text = <<EOH
  # EOH
  #   ;
  #   $text =~ s/\n/ /g;
  #   $text =~ s/\| /\n\n/g;

  #   my $greeting = $top -> Toplevel(-class=>'horae');
  #   $greeting -> protocol(WM_DELETE_WINDOW => sub{$greeting->destroy});
  #   $greeting -> iconbitmap('@'.$iconbitmap);
  #   $greeting -> title("Welcome to the new version Artemis");
  #   my $textbox = $greeting -> Scrolled('ROText',
  # 				      -scrollbars=>'oe',
  # 				      -width=>80,
  # 				      -height=>30,
  # 				      -wrap=>'word',
  # 				      -font=>'Courier 14')
  #     -> pack(-side=>'top');
  #   $textbox -> Subwidget("yscrollbar")
  #     -> configure(-background=>$config{colors}{background});
  #   $textbox -> insert('end', $text);
  #   $greeting -> Button(-text=>'OK', -command=>sub{$greeting->destroy})
  #     -> pack(-side=>'bottom');
  #   $greeting -> waitWindow;

  $config{general}{greetings} = $VERSION;
  $config_ref -> WriteConfig($personal_rcfile);
};


## if ($is_windows) {
##   open PARID, ">".$paths{data0} -> find('artemis', 'par');
##   print PARID $ENV{PAR_TEMP}, $/;
##   close PARID;
## };


$top -> update;
my $w = $mru{geometry}{uwidth} || 600;
my $h = $mru{geometry}{uheight} || 300;
$update->geometry(join("x", $w, $h));

my @geom = split(/[+x]/, $top->geometry);
## if (exists $mru{geometry}{uheight}) {
##   my $w = ($mru{geometry}{uwidth}  > $geom[0]) ? $mru{geometry}{uwidth}  : $geom[0];
##   my $h = ($mru{geometry}{uheight} > $geom[1]) ? $mru{geometry}{uheight} : $geom[1];
##   $top->geometry(join("x", $w, $h));
## };
my $extrabit = ($Tk::VERSION < 804) ? 30 : 0;
($extrabit = 0) if ($is_windows);
$top -> minsize($geom[0], $geom[1]+$extrabit);
$top -> update;
if (exists $mru{geometry}{'x'}) {
  my $location = "+" . $mru{geometry}{'x'} . "+" . $mru{geometry}{'y'};
  #$mru{geometry}{height} . "x" . $mru{geometry}{width} .
  $top -> geometry($location);
};
if (exists $mru{geometry}{width}) {
  my $size = $mru{geometry}{width} . "x" . $mru{geometry}{height};
  $top -> geometry($size);
};

$top -> update;


$fat -> pack(-expand => 0);
$fat -> packPropagate(0);
$skinny2 -> packPropagate(0);


# else {
## the next line serves to make the DPL a bit wider
##$top -> geometry(sprintf("%dx%d",$config{geometry}{window_multiplier}*$geom[0], $geom[1]+$extrabit));
##};

$top -> resizable(1,1);
$top -> deiconify;
$top -> raise;


## read a project specified from the command line or an actuve
## autosave file
my $response = 'No';
if (-e $autosave_filename) {
  my $message = "Artemis found an autosave file, perhaps from a previous failure of Artemis.  Would you like to import it?";
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => $message,
		   -title          => 'Artemis: Import autosave file?',
		   -buttons        => [qw/Yes No/],
		   -default_button => 'Yes',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  $response = $dialog->Show();
};
if ($response eq 'Yes') {
  Echo("Importing autosave file ...");
  my $save_cdd = $current_data_dir;
  ##&dispatch_mru($autosave_filename, 0);
  &dispatch_read_data(0, $autosave_filename, 0);
  $current_data_dir = $save_cdd;
  $project_name = "";
  Echo("Importing autosave file ... done!");
} elsif ($ARGV[0]) {
  Echo("Processing filename from command line");
  if ($ARGV[0] =~ /^-(\d+)$/) {
    &dispatch_mru($mru{mru}{$1});
  } elsif (-e $ARGV[0]) {
    my $arg = ($ARGV[0] =~ /^[\~\/]/) ? $ARGV[0] : File::Spec->catfile(Cwd::cwd, $ARGV[0]);
    $top -> after(500, sub{read_data(0, $arg)});
    #($project_name = $arg) if (&dispatch_mru($arg) eq "project");
  };
};


MainLoop();

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2010 Bruce Ravel
##
## THE MAIN WINDOW


###===================================================================
### set up widgets in main windows
###===================================================================

sub make_opparams {
  my $parent = $_[0];

  my @pluck_button  = (-foreground       => $config{colors}{highlightcolor},
		       -activeforeground => $config{colors}{activehighlightcolor},
		       -background       => $config{colors}{background},
		       -activebackground => $config{colors}{activebackground});
  my @start = ("-foreground", $config{colors}{activehighlightcolor}, "-font", $config{fonts}{med});
  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 $c = $parent -> Frame(-relief=>'flat',
			   #@window_size,
			   -borderwidth=>0,
			   -highlightcolor=>$config{colors}{background})
    -> pack(-fill=>'both', -expand=>1);

  ## titles
  my $lfr = $c -> LabFrame(-label      => 'Titles',
			   -font       => $config{fonts}{med},
			   -foreground => $config{colors}{activehighlightcolor},
			   -labelside  => 'acrosstop',
			   -width      => 14)
    -> pack(-side=>'top', -padx=>4, -fill=>'x');
  &labframe_help($lfr);
  push @op_text, $lfr;
  $widgets{op_titles} = $lfr -> Scrolled('Text',
					 -height=>5,
					 -font=>$config{fonts}{fixed},
					 -scrollbars=>'se',
					 -width=>50,
					 -wrap=>'none')
    -> pack(-fill=>'x', -padx=>4, -pady=>4);
  &disable_mouse3($widgets{op_titles}->Subwidget("text"));
  BindMouseWheel($widgets{op_titles});
  $widgets{op_titles}->Subwidget("xscrollbar")
    ->configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));
  $widgets{op_titles}->Subwidget("yscrollbar")
    ->configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));


  ## data and background files
  my $fr = $c -> Frame()
    -> pack(-side=>'top', -fill=>'x', -padx=>12, -pady=>0);
  my $t = $fr -> Label(-text=>"Data file", @start,
		       -font=>$config{fonts}{bold},)
    -> pack(-side=>'left');
  &click_help($t);
  push @op_text, $t;
  $widgets{op_file} = $fr -> Entry(-relief=>'groove',
				   -width=>43,
				   -borderwidth=>2,
				   -foreground=>$config{colors}{foreground},
				   -background  => $config{colors}{background2},
				   ($Tk::VERSION > 804) ? (-disabledforeground=>$config{colors}{foreground}) : (),
				 )
    -> pack(-side=>'right', -fill=>'x', -expand=>1, -padx=>4, -pady=>2);
  $widgets{op_file} -> configure(-state=>'disabled');

  $temp{data_showing} = "chi";
  $fr = $c -> Frame();
  #$fr -> pack(-side=>'top', -padx=>6, -pady=>0,);
  $widgets{show_chi} = $fr -> Radiobutton(-text     => 'Show chi(k)',
					  -value    => 'chi',
					  -variable => \$temp{data_showing},
					  -state    => 'disabled',
					  -command  => sub{
					    $widgets{mu_frame}  -> packForget;
					    $widgets{chi_frame} -> pack(-side=>'top', -padx=>6, -pady=>0,);
					 })
    -> pack(-side=>'left', -padx=>6);
  $widgets{show_mu}  = $fr -> Radiobutton(-text     => 'Show mu(E)',
					  -value    => 'mu',
					  -variable => \$temp{data_showing},
					  -state    => 'disabled',
					  -command  => sub{
					    $widgets{chi_frame} -> packForget;
					    $widgets{mu_frame}  -> pack(-side=>'top', -padx=>6, -pady=>0,);
					 })
    -> pack(-side=>'left', -padx=>6);

  $widgets{mu_frame} = $c -> Frame();
  $widgets{chi_frame} = $c -> Frame()
    -> pack(-side=>'top', -padx=>6, -pady=>0,);
  $fr = $widgets{chi_frame} -> Frame()
    -> pack(-side=>'top');
  my $left = $fr -> LabFrame(-label	 => 'Data controls',
			     -font	 => $config{fonts}{med},
			     -foreground => $config{colors}{activehighlightcolor},
			     -labelside	 => 'acrosstop',
			     -width	 => 14)
    -> pack(-side=>'left', -padx=>4, -fill=>'x', -anchor=>'n');
  &labframe_help($left);
  push @op_text, $left;
  $widgets{controls_frame} = $left;
  $widgets{op_include} = $left -> Checkbutton(-text=>'Include in the fit',
					      -foreground=>$config{colors}{foreground},
					      -activeforeground=>$config{colors}{foreground},
					      -selectcolor=>$config{colors}{check},
					      -font=>$config{fonts}{med},
					      -variable=>\$temp{op_include},
					      -onvalue=>1, -offvalue=>0,
					      -command=>
					      sub{my $this = $paths{$current}->data;
						  $paths{$this}->make(include=>$temp{op_include});
						  &toggle_data($this);
						  project_state(0);
						},
					     )
    -> pack(-side=>'top', -anchor=>'w');
  $widgets{op_plot} =
    $left -> Checkbutton(-text=>'Plot after the fit',
			 -foreground=>$config{colors}{foreground},
			 -activeforeground=>$config{colors}{foreground},
			 -selectcolor=>$config{colors}{check},
			 -font=>$config{fonts}{med},
			 -variable=>\$temp{op_plot},
			 -onvalue=>1, -offvalue=>0,
			 -command=>
			 sub{my $this = $paths{$current}->data;
			     $paths{$this}->make(plot=>$temp{op_plot});
			     project_state(0);
			     #my @all = &all_data;
			     #if ($#all == 1) {
			     #  foreach my $d (@all) {
			     #	 next if ($d eq $this);
			     #	 $paths{$d}->make(plot=>abs($temp{op_plot}-1));
			     #  };
			     #} else {
			     #  foreach my $d (@all) {
			     # 	 next if ($d eq $this);
			     #	 $paths{$d}->make(plot=>0);
			     #  };
			     #};
			   },
			)
    -> pack(-side=>'top', -anchor=>'w');

  $widgets{op_do_bkg} = $left -> Checkbutton(-text=>'Fit background',
					     -foreground=>$config{colors}{foreground},
					     -activeforeground=>$config{colors}{foreground},
					     -selectcolor=>$config{colors}{check},
					     -font=>$config{fonts}{med},
					     -variable=>\$temp{op_do_bkg},
					     -onvalue=>"yes", -offvalue=>'no',
					     -command=>
					     sub{my $this = $paths{$current}->data;
						 $paths{$this}->make(do_bkg=>$temp{op_do_bkg});
						 project_state(0);
					       },
					    )
    -> pack(-side=>'top', -anchor=>'w');







  ## k parameters
  $fr = $fr -> LabFrame(-label	    => 'Fourier and fit parameters',
			-font	    => $config{fonts}{med},
			-foreground => $config{colors}{activehighlightcolor},
			-labelside  => 'acrosstop',
			-width	    => 14)
    -> pack(-side=>'right', -padx=>4, -fill=>'x', -anchor=>'n');
  &labframe_help($fr);
  push @op_text, $fr;

  $t = $fr -> Label(@start, -text=>'k-range')
    -> grid(-column=>0, -row=>0, -sticky=>'w', -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_kmin} = $fr -> Entry(-width=>6,
				   -validate=>'key',
				   -validatecommand=>[\&set_opparam, 'kmin'])
    -> grid(-column=>1, -row=>0, -sticky=>'w');
  $grab{op_kmin} = $fr -> Button(@pluck_button, @pluck,
				 -command=>[\&pluck, 'op_kmin'])
    -> grid(-column=>2, -row=>0, -sticky=>'w');
  $t = $fr -> Label(@start, -text=>'  to  ')
    -> grid(-column=>3, -row=>0, -sticky=>'w', -padx=>2);
  push @op_text, $t;
  $widgets{op_kmax} = $fr -> Entry(-width=>6,
				   -validate=>'key',
				   -validatecommand=>[\&set_opparam, 'kmax'])
    -> grid(-column=>4, -row=>0, -sticky=>'w');
  $grab{op_kmax} = $fr -> Button(@pluck_button, @pluck,
				-command=>[\&pluck, 'op_kmax'])
    -> grid(-column=>5, -row=>0, -sticky=>'w');

  ## R parameters
  $t = $fr -> Label(@start, -text=>'R-range')
    -> grid(-column=>0, -row=>1, -sticky=>'w', -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_rmin} = $fr -> Entry(-width=>6,
				   -validate=>'key',
				   -validatecommand=>[\&set_opparam, 'rmin'])
    -> grid(-column=>1, -row=>1, -sticky=>'w');
  $grab{op_rmin} = $fr -> Button(@pluck_button, @pluck,
				 -command=>[\&pluck, 'op_rmin'])
    -> grid(-column=>2, -row=>1, -sticky=>'w');
  $t = $fr -> Label(@start, -text=>'  to  ')
    -> grid(-column=>3, -row=>1, -sticky=>'w', -padx=>2);
  push @op_text, $t;
  $widgets{op_rmax} = $fr -> Entry(-width=>6,
				   -validate=>'key',
				   -validatecommand=>[\&set_opparam, 'rmax'])
    -> grid(-column=>4, -row=>1, -sticky=>'w');
  $grab{op_rmax} = $fr -> Button(@pluck_button, @pluck,
				 -command=>[\&pluck, 'op_rmax'])
    -> grid(-column=>5, -row=>1, -sticky=>'w');

  $t = $fr -> Label(@start, -text=>'dk')
    -> grid(-column=>0, -row=>2, -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_dk} = $fr -> Entry(-width=>6,
				 -validate=>'key',
				 -validatecommand=>[\&set_opparam, 'dk'])
    -> grid(-column=>1, -row=>2, -sticky=>'w');
  $t = $fr -> Label(@start, -text=>'dr')
    -> grid(-column=>3, -row=>2, -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_dr} = $fr -> Entry(-width=>6,
				 -validate=>'key',
				 -validatecommand=>[\&set_opparam, 'dr'])
    -> grid(-column=>4, -row=>2, -sticky=>'w');

  $t = $fr -> Label(@start, -text=>'k window')
    -> grid(-column=>0, -row=>3, -sticky=>'e', -columnspan=>2, -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_kwindow} = $fr -> Optionmenu(-textvariable => \$temp{op_kwindow},
					   -borderwidth=>1)
    -> grid(-column=>2, -row=>3, -sticky=>'w', -columnspan=>4, -pady=>2);
  foreach my $i ($paths{data0}->Windows) {
    my $l = ucfirst($i);
    ($i eq "kaiser-bessel") and ($l = "Kaiser-Bessel");
    $widgets{op_kwindow} -> command(-label => $l,
				    -command=>
				    sub {
				      my $this = $paths{$current}->data;
				      $paths{$this}->make(kwindow=>$i);
				      &toggle_do('r');
				      $temp{op_kwindow} = ucfirst($l);
				      ($temp{op_kwindow} eq "kaiser-bessel") and
					($temp{op_kwindow} = "Kaiser-Bessel");
				      project_state(0);
				    });
  };
  $t = $fr -> Label(@start, -text=>'R window')
    -> grid(-column=>0, -row=>4, -sticky=>'e', -columnspan=>2, -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_rwindow} = $fr -> Optionmenu(-textvariable => \$temp{op_rwindow},
					   -borderwidth=>1,)
    -> grid(-column=>2, -row=>4, -sticky=>'w', -columnspan=>4);
  foreach my $i ($paths{data0}->Windows) { #($setup->Windows) {
    my $l = ucfirst($i);
    ($i eq "kaiser-bessel") and ($l = "Kaiser-Bessel");
    $widgets{op_rwindow} -> command(-label => $l,
				    -command=>
				    sub{
				      my $this = $paths{$current}->data;
				      $paths{$this}->make(rwindow=>$i);
				      &toggle_do('q');
				      $temp{op_rwindow} = ucfirst($l);
				      ($temp{op_rwindow} eq "kaiser-bessel") and
					($temp{op_rwindow} = "Kaiser-Bessel");
				      project_state(0);
				    })
  };



  ## k-weighting
  $fr = $widgets{chi_frame} -> Frame()
    -> pack(-side=>'bottom', -padx=>12, -pady=>4);

  ## fitting space and other fit params
  $left = $fr -> LabFrame(-label      => 'Other parameters',
			  -font	      => $config{fonts}{med},
			  -foreground => $config{colors}{activehighlightcolor},
			  -labelside  => 'acrosstop',
			  -width      => 14)
    -> pack(-side=>'left', -padx=>4, -fill=>'x', -anchor=>'n');
  &labframe_help($left);
  push @op_text, $left;
  my $inner = $left -> Frame()
    -> pack(-side=>'top', -fill=>'x', -padx=>2, -pady=>2);
  $t = $inner -> Label(@start, -text=>'Fitting space ',)
    -> pack(-side=>'left', -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_fitspace} = $inner -> Optionmenu(-textvariable => \$temp{op_fitspace},
					       -borderwidth=>1,)
    -> pack(-side=>'left');
  foreach my $i (qw(k R q)) {
    $widgets{op_fitspace} -> command(-label => $i,
				     -command=>sub{my $curr;
						   ($current =~ /(\d+)$/) and ($curr = $1);
						   foreach my $d (&every_data) {
						     $paths{$d}->make(fit_space=>$i);
						   };
						   project_state(0);
						   $temp{op_fitspace} = $i; })
  };
  $t = $inner -> Label(-text=>' ',)
    -> pack(-side=>'left');
  $t = $inner -> Label(-text=>'Epsilon ', @start,)
    -> pack(-side=>'left', -padx=>0);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_epsilon_k} = $inner -> Entry(-width=>6,
					   -validate=>'key',
					   -validatecommand=>[\&set_opparam, 'epsilon_k'])
    -> pack(-side=>'left');

  $inner =  $left -> Frame()
    -> pack(-side=>'top', -fill=>'x', -padx=>2, -pady=>2);
  $t = $inner -> Label(@start, -text=>'Minimum reported correlation ')
    -> pack(-side=>'left', -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_cormin} = $inner -> Entry(-width=>6,
					-validate=>'key',
					-validatecommand=>[\&set_opparam, 'cormin'])
    -> pack(-side=>'left');


  ## phase corrections and epsilon_k
  $t = $left -> Label(@start, -text=>'Path to use for phase corrections  ',)
    -> pack(-side=>'top', -anchor=>'w', -padx=>2);
  &click_help($t);
  push @op_text, $t;
  $widgets{op_pcpath} = $left -> Optionmenu(-textvariable => \$temp{op_pcpath_label},
					    -borderwidth=>1,)
    -> pack(-side=>'top', -anchor=>'e', -padx=>5);

  $widgets{help_op} = $left -> Button(-text => "Document: Fitting parameters", @button2_list,
				      -command=>sub{pod_display("artemis_opparams.pod")},
				      )
    -> pack(-side=>'bottom', -padx=>2, -fill=>'x', -pady=>2);




  my $right = $fr -> LabFrame(-label	  => 'Fit k-weights',
			      -font	  => $config{fonts}{med},
			      -foreground => $config{colors}{activehighlightcolor},
			      -labelside  => 'acrosstop',
			      -width	  => 14)
    -> pack(-side=>'right', -padx=>4, -fill=>'x', -anchor=>'n');
  &labframe_help($right);
  push @op_text, $right;
  $widgets{op_k1} = $right ->
    Checkbutton(-text=>'kw=1',
		-foreground=>$config{colors}{foreground},
		-activeforeground=>$config{colors}{foreground},
		-selectcolor=>$config{colors}{check},
		-font=>$config{fonts}{med},
		-variable=>\$temp{op_k1},
		-onvalue=>1, -offvalue=>0,
		-command=>
		sub{
		  $paths{$current}->make(k1=>$temp{op_k1});
		  project_state(0);
		}
	       )
    -> pack(-side=>'top', -anchor=>'w');
  $widgets{op_k2} = $right ->
    Checkbutton(-text=>'kw=2',
		-foreground=>$config{colors}{foreground},
		-activeforeground=>$config{colors}{foreground},
		-selectcolor=>$config{colors}{check},
		-font=>$config{fonts}{med},
		-variable=>\$temp{op_k2},
		-onvalue=>1, -offvalue=>0,
		-command=>
		sub{
		  $paths{$current}->make(k2=>$temp{op_k2});
		  project_state(0);
		}
	       )
    -> pack(-side=>'top', -anchor=>'w');
  $widgets{op_k3} = $right ->
    Checkbutton(-text=>'kw=3',
		-foreground=>$config{colors}{foreground},
		-activeforeground=>$config{colors}{foreground},
		-selectcolor=>$config{colors}{check},
		-font=>$config{fonts}{med},
		-variable=>\$temp{op_k3},
		-onvalue=>1, -offvalue=>0,
		-command=>
		sub{
		  $paths{$current}->make(k3=>$temp{op_k3});
		  project_state(0);
		}
	       )
    -> pack(-side=>'top', -anchor=>'w');
  $widgets{op_karb_use} = $right ->
    Checkbutton(-text=>'other k weight',
		-foreground=>$config{colors}{foreground},
		-activeforeground=>$config{colors}{foreground},
		-selectcolor=>$config{colors}{check},
		-font=>$config{fonts}{med},
		-variable=>\$temp{op_karb_use},
		-onvalue=>1, -offvalue=>0,
		-command=>
		sub{
		  $widgets{op_karb} ->
		    configure(-state=>$temp{op_karb_use} ? 'normal' : 'disabled');
		  $paths{$current}->make(karb_use=>$temp{op_karb_use});
		  project_state(0);
		}
	       )
    -> pack(-side=>'top', -anchor=>'w');
  $widgets{op_karb} = $right -> Entry(-width=>6,
				      -validate=>'key',
				      -validatecommand=>[\&set_opparam, 'karb'])
    -> pack(-side=>'right', -anchor=>'se');


  ## fill in the mu(E) tab
  $fr = $widgets{mu_frame} -> LabFrame(-label	   => 'Background Removal Parameters',
				       -font	   => $config{fonts}{med},
				       -foreground => $config{colors}{activehighlightcolor},
				       -labelside  => 'acrosstop',)
    -> pack(-fill=>'x', -anchor=>'n', -pady=>2);
  $fr -> Label(@start, -text=>'E0')
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $widgets{bkg_e0} = $fr -> Entry(-width=>9,
				  -validate=>'key',
				  -validatecommand=>[\&set_opparam, 'bkg_e0'])
    -> grid(-row=>0, -column=>1, -sticky=>'w');

  $fr -> Label(@start, -text=>'E shift')
    -> grid(-row=>0, -column=>3, -sticky=>'e');
  $widgets{bkg_eshift} = $fr -> Entry(-width=>9,
				      -validate=>'key',
				      -validatecommand=>[\&set_opparam, 'bkg_eshift'])
    -> grid(-row=>0, -column=>4, -sticky=>'w');

  $fr -> Label(@start, -text=>'Rbkg')
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $widgets{bkg_rbkg} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_rbkg'])
    -> grid(-row=>1, -column=>1, -sticky=>'w');

  $fr -> Label(@start, -text=>'kw')
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $widgets{bkg_kw} = $fr -> Entry(-width=>9,
				  -validate=>'key',
				  -validatecommand=>[\&set_opparam, 'bkg_kw'])
    -> grid(-row=>2, -column=>1, -sticky=>'w');

  $fr -> Label(@start, -text=>'step')
    -> grid(-row=>2, -column=>3, -sticky=>'e');
  $widgets{bkg_step} = $fr -> NumEntry(-width=>6,
				       -orient=>'horizontal',
				       -increment=>0.1)
    -> grid(-row=>2, -column=>4, -sticky=>'w');
  $widgets{bkg_fixstep} = $fr -> Checkbutton(-text=>'fix step',
					     -foreground=>$config{colors}{foreground},
					     -activeforeground=>$config{colors}{foreground},
					     -selectcolor=>$config{colors}{check},
					     -font=>$config{fonts}{med},
					     -variable=>\$temp{bkg_fixstep},
					     -onvalue=>1, -offvalue=>0,
					     -command=> sub{ $paths{$current}->make(bkg_fixstep=>$temp{bkg_fixstep});
							     project_state(0);
							   },
					    )
    -> grid(-row=>2, -column=>5, -sticky=>'w');
  $widgets{bkg_flatten} = $fr -> Checkbutton(-text=>'flatten',
					     -foreground=>$config{colors}{foreground},
					     -activeforeground=>$config{colors}{foreground},
					     -selectcolor=>$config{colors}{check},
					     -font=>$config{fonts}{med},
					     -variable=>\$temp{bkg_flatten},
					     -onvalue=>1, -offvalue=>0,
					     -command=> sub{ $paths{$current}->make(bkg_flatten=>$temp{bkg_flatten});
							     project_state(0);
							   },
					    )
    -> grid(-row=>1, -column=>5, -sticky=>'w');


  $fr -> Label(@start, -text=>'Pre-edge')
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $widgets{bkg_pre1} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_pre1'])
    -> grid(-row=>3, -column=>1, -sticky=>'w');
  $grab{bkg_pre1} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>3, -column=>2, -sticky=>'w');
  $fr -> Label(@start, -text=>' to ')
    -> grid(-row=>3, -column=>3, -sticky=>'e');
  $widgets{bkg_pre2} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_pre2'])
    -> grid(-row=>3, -column=>4, -sticky=>'w');
  $grab{bkg_pre2} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>3, -column=>5, -sticky=>'w');

  $fr -> Label(@start, -text=>'Normalization')
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $widgets{bkg_nor1} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_nor1'])
    -> grid(-row=>4, -column=>1, -sticky=>'w');
  $grab{bkg_nor1} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>4, -column=>2, -sticky=>'w');
  $fr -> Label(@start, -text=>' to ')
    -> grid(-row=>4, -column=>3, -sticky=>'e');
  $widgets{bkg_nor2} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_nor2'])
    -> grid(-row=>4, -column=>4, -sticky=>'w');
  $grab{bkg_nor2} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>4, -column=>5, -sticky=>'w');

  $fr -> Label(@start, -text=>'Spline')
    -> grid(-row=>5, -column=>0, -sticky=>'e');
  $widgets{bkg_spl1} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_spl1'])
    -> grid(-row=>5, -column=>1, -sticky=>'w');
  $grab{bkg_spl1} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>5, -column=>2, -sticky=>'w');
  $fr -> Label(@start, -text=>' to ')
    -> grid(-row=>5, -column=>3, -sticky=>'e');
  $widgets{bkg_spl2} = $fr -> Entry(-width=>9,
				    -validate=>'key',
				    -validatecommand=>[\&set_opparam, 'bkg_spl2'])
    -> grid(-row=>5, -column=>4, -sticky=>'w');
  $grab{bkg_spl2} = $fr -> Button(@pluck_button, @pluck,
				  #-command=>[\&pluck, 'op_rmax']
				 )
    -> grid(-row=>5, -column=>5, -sticky=>'w');

  $fr -> Label(@start, -text=>'High end clamp')
    -> grid(-row=>6, -column=>0, -sticky=>'e');
  $widgets{bkg_clamp2} = $fr -> Optionmenu(-options  => ['None', 'Slight', 'Weak', 'Medium', 'Strong', 'Rigid'],
					   -command  => sub{ $paths{$current}->make(bkg_clamp2=>$temp{bkg_clamp2}, do_xmu=>1);
							     project_state(0);
							   },
					   -textvariable => \$temp{bkg_clamp2},
					  )
    -> grid(-row=>6, -column=>1, -columnspan=>2, -sticky=>'w');



#  $fr = $widgets{mu_frame} -> LabFrame(-label=>'mu(E) plot controls',
#                                      -font=>$config{fonts}{med},
#				       -foreground=>$config{colors}{activehighlightcolor},
#				       -labelside=>'acrosstop',)
  $fr = $widgets{mu_frame} -> Frame(-borderwidth => 2,
				    -relief      => 'groove')
    -> pack(-anchor=>'n', -pady=>0);

  $fr -> Checkbutton(-text=>'mu(E) data')
    -> grid(-column=>0, -row=>0, -sticky=>'w');
  $fr -> Checkbutton(-text=>'background')
    -> grid(-column=>1, -row=>0, -sticky=>'w');
  $fr -> Checkbutton(-text=>'pre edge line')
    -> grid(-column=>0, -row=>1, -sticky=>'w');
  $fr -> Checkbutton(-text=>'post edge line')
    -> grid(-column=>1, -row=>1, -sticky=>'w');
  $fr -> Checkbutton(-text=>'normalized')
    -> grid(-column=>0, -row=>2, -sticky=>'w');
  $fr -> Checkbutton(-text=>'derivative')
    -> grid(-column=>1, -row=>2, -sticky=>'w');
  $fr -> Button(-text=>'Plot in energy', -width=>20, @button_list)
    -> grid(-column=>2, -row=>0, -sticky=>'ew');
  $fr -> Button(-text=>'Save chi(k)', -width=>20, @button_list)
    -> grid(-column=>2, -row=>2, -sticky=>'ew');

  return $c;
};

sub pluck {
  my $widg = $_[0];
  my $parent = $_[1] || $top;
  Echo("You have not made a plot yet."), return 0
    unless ($last_plot);

  if (($last_plot eq 'r') and ($widg =~ /^op_k/)) {
    Echo("You cannot pluck an k value from the last plot, which was an R plot.");
    return 0;
  } elsif (($last_plot eq 'k') and ($widg =~ /^op_r/)) {
    Echo("You cannot pluck an R value from the last plot, which was an k plot.");
    return 0;
  } elsif (($last_plot eq 'q') and ($widg =~ /^op_r/)) {
    Echo("You cannot pluck an R value from the last plot, which was an q plot.");
    return 0;
  };
  Echo("Select a value for $widg from the plot...");
  my ($cursor_x, $cursor_y) = (0,0);
  $grab{$widg} -> grab();
  $top -> Busy();
  my $data = &first_data;
  $paths{$data}->dispose("cursor(crosshair=true)\n", 1);
  ($cursor_x, $cursor_y) = (Ifeffit::get_scalar("cursor_x"),
			    Ifeffit::get_scalar("cursor_y"));
  $top -> Unbusy;
  $grab{$widg} -> grabRelease();
  my $value = sprintf("%.3f", $cursor_x);
  my $which = substr($widg, 3);
  set_opparam($which, $value, 1);
  #Echo("Plucked the value of $value for " . (split(/_/, $widg))[1] );
  $widgets{$widg} -> configure(-validate=>'none');
  $widgets{$widg} -> delete(qw/0 end/);
  $widgets{$widg} -> insert(0, $value);
  $widgets{$widg} -> configure(-validate=>'key');
  return 1;
};


## lab frame labels...
sub click_help {
  my $t = shift;
  my $text = $t->cget('-text');
  $text =~ s/\s+$//;

  ## don't post mouse-3 menu for some parameters
  my $skip = ($text =~ /^(Data|Epsilon|Path)/);

  my @bold   = (-foreground => $config{colors}{mbutton},
		-background => $config{colors}{activebackground},
		-cursor     => $mouse_over_cursor,
		-font       => ($text =~ /Data file/) ? $config{fonts}{bold} : $config{fonts}{med});
  my @normal = (-foreground => $config{colors}{activehighlightcolor},
		-background => $config{colors}{background},
		-font       => ($text =~ /Data file/) ? $config{fonts}{bold} : $config{fonts}{med});
  my @nodata = (-foreground => $config{colors}{activehighlightcolor},
		-background => $config{colors}{background},
		-font       => ($text =~ /Data file/) ? $config{fonts}{bold} : $config{fonts}{med});

  $t -> bind("<Any-Enter>", sub {shift->configure(@bold)});
  $t -> bind("<Any-Leave>", sub {my $tt=shift;
				 if ($n_data) {
				   $tt->configure(@normal);
				 } else {
				   $tt->configure(@nodata);
				 }
			       });

  my $str = $click_help{$text} || "$text ???";
  $t -> bind('<ButtonPress-1>' => sub{Echo("$str")});
  $t -> bind("<ButtonPress-3>",
	     sub{ return unless $n_data;
	          my @every = &every_data;
		  my $menu=$top->Menu(-tearoff=>0,
				      -menuitems=>[(($text =~ /^(Minimum)/) ? () :
						    (["command"=>"Set all data sets to this value of \`$text\'",
						      -command => [\&constrain_param, $text, 'all'],
						      -state=>($#every)?'normal':'disabled'],
						     "-",
						     ["command"=>"Grab \`$text\' from previous data set",
						      -command => [\&constrain_param, $text, 'prev'],
						      -state=>($#every)?'normal':'disabled' ],
						     ["command"=>"Grab \`$text\' from next data set",
						      -command => [\&constrain_param, $text, 'next'],
						      -state=>($#every)?'normal':'disabled' ],
						     "-",)),
						   [ command => "Restore default value for \`$text\'",
						     -command => [\&restore_default, $text]],
						  ]);
		  $menu ->Popup(-popover=>'cursor', -popanchor=>'w');
		})
    unless $skip;
};

sub labframe_help {
  my $lf = $_[0];
  my $t = $lf->Subwidget("label");
  my $text = $t->cget('-text');
  $text =~ s/\s+$//;

  my $skip = ($text !~ /^(Fit|Fourier|Space)/);

  my @bold   = (-foreground => $config{colors}{mbutton},
		-cursor     => $mouse_over_cursor,
	       );
  my @normal = (-foreground => $config{colors}{activehighlightcolor},);
  my @nodata = (-foreground => $config{colors}{activehighlightcolor},);

  $t -> bind("<Any-Enter>", sub {shift->configure(@bold)});
  $t -> bind("<Any-Leave>", sub {my $tt=shift;
				 if (($n_data) or ($text =~ /^Space/)) {
				   $tt->configure(@normal);
				 } else {
				   $tt->configure(@nodata);
				 }});
  my $str = $click_help{$text} || "$text ???";
  $t -> bind('<ButtonPress-1>' => sub{Echo("$str")});
  $t -> bind("<ButtonPress-3>",
	     sub{ return unless $n_data;
	          my @every = &every_data;
		  my $menu=$top->Menu(-tearoff=>0,
				      -menuitems=>[["command"=>"Set all data sets to this value of \`$text\'",
						    -command => [\&constrain_param, $text, 'all'],
						    -state=>($#every)?'normal':'disabled'],
						   "-",
						   ["command"=>"Grab \`$text\' from previous data set",
						    -command => [\&constrain_param, $text, 'prev'],
						    -state=>($#every)?'normal':'disabled' ],
						   ["command"=>"Grab \`$text\' from next data set",
						    -command => [\&constrain_param, $text, 'next'],
						    -state=>($#every)?'normal':'disabled' ],
						   "-",
						   [ command => "Restore default value for \`$text\'",
						     -command => [\&restore_default, $text]],
						  ]);
		  $menu ->Popup(-popover=>'cursor', -popanchor=>'w');
		})
    unless $skip;

};


sub constrain_param {
  my ($which, $how) = @_;
  $which = lc($which);
  my $this = $paths{$current}->data;
  my @vars = ();
WHICH: {
    @vars = (qw(kmin kmax)), last WHICH if ($which eq 'k-range');
    @vars = (qw(rmin rmax)), last WHICH if ($which eq 'r-range');
    @vars = (qw(dk)),        last WHICH if ($which eq 'dk');
    @vars = (qw(dr)),        last WHICH if ($which eq 'dr');
    @vars = (qw(kwindow)),   last WHICH if ($which eq 'k window');
    @vars = (qw(rwindow)),   last WHICH if ($which eq 'r window');
    @vars = (qw(pcpath)),    last WHICH if ($which =~ /^Path/);
    @vars = (qw(epsilon_k)), last WHICH if ($which eq 'epsilon');
    @vars = (qw(k1 k2 k3 karb karb_use)),
      last WHICH if ($which =~ /^fit/);
    @vars = (qw(kmin kmax dk rmin rmax dr kwindow rwindow)),
      last WHICH if ($which =~ /^fourier/);
  };
 HOW: {
    ($how eq 'all') and do {
      foreach my $d (&every_data) {
	foreach my $v (@vars) {
	  next if ($d eq $this);
	  $paths{$d} -> make($v=>$paths{$this}->get($v));
	};
      };
      &display_properties;
      project_state(0);
      Echo("Set \`$which\' for all data sets");
      last HOW;
    };
    ($how eq 'next') and do {
      my $found = 0;
      my $next  = "";
      foreach my $d (sort(&all_data)) {
	($next = $d), last if $found;
	($found = 1) if ($d eq $this);
      };
      Error("This is the last data set"), last HOW unless $next;
      foreach my $v (@vars) {
	$paths{$this} -> make($v=>$paths{$next}->get($v));
      };
      &display_properties;
      project_state(0);
      Echo("Grabbed \`$which\' from the next data set");
      last HOW;
    };
    ($how eq 'prev') and do {
      my $found = 0;
      my $prev  = "";
      foreach my $d (sort(&all_data)) {
	last if ($d eq $this);
	$prev = $d;
      };
      Error("This is the first data set"), last HOW unless $prev;
      foreach my $v (@vars) {
	$paths{$this} -> make($v=>$paths{$prev}->get($v));
      };
      &display_properties;
      project_state(0);
      Echo("Grabbed \`$which\' from the previous data set");
      last HOW;
    };
  };

};


sub restore_default {
  my $which = $_[0];
  $which = lc($which);
  my $this = $paths{$current}->data;
  my @vars = ();
WHICH: {
    @vars = (qw(kmin kmax)), last WHICH if ($which eq 'k-range');
    @vars = (qw(rmin rmax)), last WHICH if ($which eq 'r-range');
    @vars = (qw(dk)),        last WHICH if ($which eq 'dk');
    @vars = (qw(dr)),        last WHICH if ($which eq 'dr');
    @vars = (qw(kwindow)),   last WHICH if ($which eq 'k window');
    @vars = (qw(rwindow)),   last WHICH if ($which eq 'r window');
    @vars = (qw(fit_space)), last WHICH if ($which eq 'fitting space');
    @vars = (qw(cormin)),    last WHICH if ($which =~ /^minimum/);
    #@vars = (qw(pcpath)),    last WHICH if ($which =~ /^Path/);
    @vars = (qw(k1 k2 k3 karb karb_use)),
      last WHICH if ($which =~ /^fit/);
    @vars = (qw(kmin kmax dk rmin rmax dr kwindow rwindow)),
      last WHICH if ($which =~ /^fourier/);
    @vars = (qw(kmin kmax rmin rmax dk dr kwindow rwindow k1 k2 k3 karb karb_use)),
      last WHICH if ($which eq 'all');
  };
  foreach my $v (@vars) {
    if ($v =~ /^k(1|2|3|arb(|_use))/) {
      $temp{'op_'.$v} = ($v eq "k".$config{data}{kweight}) ? 1 : 0;
      $paths{$this} -> make($v=>($v eq 'k1') ? 1 : 0);
      $widgets{op_karb} -> delete(0,'end') if $v eq 'karb_use';
    } else {
      $paths{$this} -> make($v=>$config{data}{$v});
    }
  };
  $paths{$this} -> fix_values;
  &display_properties;
  project_state(0);
  ($which eq 'all') ? Echo("Restored all parameters to their defaults")
    : Echo("Restored \`$which\' to it's default");
};


sub set_spline {
  my $how = $_[0];
 HOW: {
    ($how eq 'allon') and do {
      foreach my $d (&all_data) {
	$paths{$d} -> make(do_bkg => 'yes');
      };
      &display_properties;
      last HOW;
    };
    ($how eq 'alloff') and do {
      foreach my $d (&all_data) {
	$paths{$d} -> make(do_bkg => 'no');
      };
      &display_properties;
      last HOW;
    };
  };
};

sub toggle_do {
  my $sp = "do_" . $_[0];
  my $this = $paths{$current}->data;
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($k =~ /$this/);
    $paths{$k} -> make($sp=>1);
  };
};



sub set_plotoptions {

  my $container = $_[0];
  my %parts = (m=>'Magnitude', r=>'Real part', i=>'Imaginary part', p=>'Phase');

  my $frm = $container -> Frame(-borderwidth=>2, -relief=>'groove')
    -> pack(-fill=>'x', -anchor=>'w', -pady=>4);

  $plot_features{r_pl} ||= 'm';
  $plot_features{r_pl_label} = $parts{$plot_features{r_pl}};
  $frm -> Label(-text	    => 'Plot in R: ',
		-font	    => $config{fonts}{med},
		-foreground => $config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  ##   $widgets{plot_r} = $frm -> Optionmenu(-textvariable => \$plot_features{r_pl_label},
  ## 					-width=>12,
  ## 					-borderwidth=>1,)
  ##     -> grid(-row=>0, -column=>1, -sticky=>'w');
  my $r = 0;
  my @list = ($config{plot}{plot_phase}) ? (qw(m r i p)) : (qw(m r i));
  foreach my $p (@list) {
    $frm -> Radiobutton(-value	  => $p,
			-font	  => $config{fonts}{med},
			-text	  => $parts{$p},
			-selectcolor=>$config{colors}{check},
			-variable => \$plot_features{r_pl},
			-command  => sub{$plot_features{r_pl} = $p;
					 &plot('r', 0) }
		       )
      -> grid(-row=>$r++, -column=>1, -sticky=>'w');
    ##     $widgets{plot_r} -> command(-label => $parts{$p},
    ##  				-command=>sub{$plot_features{r_pl} = $p;
    ## 					      $plot_features{r_pl_label} = $parts{$p};
    ##  					      &plot('r', 0) }
    ## 			       );
  };


  $plot_features{q_pl} ||= 'r';
  $plot_features{q_pl_label} = $parts{$plot_features{q_pl}};
  $frm -> Label(-text	    => 'Plot in q: ',
		-font	    => $config{fonts}{med},
		-foreground => $config{colors}{activehighlightcolor})
    -> grid(-row=>$r, -column=>0, -sticky=>'e');
  foreach my $p (@list) {
    $frm -> Radiobutton(-value	  => $p,
			-font	  => $config{fonts}{med},
			-text	  => $parts{$p},
			-selectcolor=>$config{colors}{check},
			-variable => \$plot_features{q_pl},
			-command  => sub{$plot_features{q_pl} = $p;
					 &plot('q', 0) }
		       )
      -> grid(-row=>$r++, -column=>1, -sticky=>'w');
  };

  $plot_features{win} ||= 0;
  $widgets{plot_win} = $container ->
    Checkbutton(-text		  => 'Window',
		-font		  => $config{fonts}{med},
		-onvalue	  => 'w',
		-offvalue         => "",
		-selectcolor	  => $config{colors}{check},
		-foreground	  => $config{colors}{activehighlightcolor},
		-activeforeground => $config{colors}{activehighlightcolor},
		-variable	  => \$plot_features{win},
		-command	  => sub{&plot($last_plot, 0)}
	       )
      -> pack();
  $widgets{plot_bkg} = $container ->
    Checkbutton(-text		  => 'Background',
		-font		  => $config{fonts}{med},
		-onvalue	  => 'b',
		-offvalue         => "",
		-selectcolor	  => $config{colors}{check},
		-activeforeground => $config{colors}{activehighlightcolor},
		-foreground	  => $config{colors}{activehighlightcolor},
		-variable	  => \$plot_features{bkg},
		-command	  => sub{&plot($last_plot, 0)}
	       )
      -> pack();

  $widgets{plot_res} = $container ->
    Checkbutton(-text		  => 'Residual',
		-font		  => $config{fonts}{med},
		-onvalue	  => 'z',
		-offvalue	  => "",
		-selectcolor	  => $config{colors}{check},
		-foreground	  => $config{colors}{activehighlightcolor},
		-activeforeground => $config{colors}{activehighlightcolor},
		-variable	  => \$plot_features{res},
		-command	  => sub{&plot($last_plot, 0)}
	       )
      -> pack();


  $frm = $container -> Frame(-borderwidth=>2, -relief=>'flat')
    -> pack(-side=>'top', -anchor=>'s');
  $plot_features{kmin} ||= 0;
  $plot_features{rmin} ||= 0;
  $plot_features{qmin} ||= 0;
  $plot_features{kmax} ||= 15;
  $plot_features{rmax} ||= 6;
  $plot_features{qmax} ||= 15;
  my $row = 0;
  foreach my $s (qw(k R q)) {
    $frm -> Label(-text	      => $s.'min:',
		  -font	      => $config{fonts}{med},
		  -foreground => $config{colors}{activehighlightcolor})
      -> grid(-row=>$row, -column=>0);
    $widgets{'plot_'.lc($s).'min'} = $frm ->
      Entry(-width=>5, -textvariable=>\$plot_features{lc($s).'min'}, -state=>'normal')
      -> grid(-row=>$row, -column=>1);
    $frm -> Label(-text	      => $s.'max:',
		  -font	      => $config{fonts}{med},
		  -foreground => $config{colors}{activehighlightcolor})
      -> grid(-row=>$row, -column=>2);
    $widgets{'plot_'.lc($s).'max'} = $frm ->
      Entry(-width=>5, -textvariable=>\$plot_features{lc($s).'max'}, -state=>'normal')
      -> grid(-row=>$row++, -column=>3);
  };
};


sub show_extra_plot {
  $widgets{plot_extra_button} -> packForget;
  $widgets{plot_extra_frame}  -> pack(-fill => 'both', -side => 'top', -expand=>1);
};
sub remove_extra_plot {
  $widgets{plot_extra_frame}  -> packForget;
  $widgets{plot_extra_button} -> pack(-fill => 'x', -side => 'bottom', -padx=>2, -pady=>4);
};

sub setup_indicators {
  my @pluck_button  = (-foreground       => $config{colors}{highlightcolor},
		       -activeforeground => $config{colors}{activehighlightcolor},
		       -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 $frame = $widgets{plot_Ind} -> Frame() -> pack(-anchor=>'n', -fill=>'both');
  $frame -> Label(-text=>"Plot indicators",
		  -font=>$config{fonts}{bold},
		  -foreground=>$config{colors}{activehighlightcolor})
     -> pack(-side=>'top');
  $extra[5] = 0;
  $frame -> Checkbutton(-text=>'Display indicators',
			-selectcolor=>$config{colors}{check},
			-variable=>\$extra[5])
    -> pack(-expand=>1, -fill=>'x', -side=>'top', -anchor=>'n');
##   my $t = $frame -> Scrolled('Pane',
## 			     -scrollbars  => 'oe',
## 			     -width	      => 1,
## 			     -height      => 1,
## 			     -borderwidth => 0,
## 			     -relief      => 'flat')
  my $t = $frame -> Frame()
    -> pack(-expand=>1, -fill=>'both', -side=>'top', -padx=>3, -pady=>3, -anchor=>'n');
##   $t -> Subwidget("yscrollbar")
##     -> configure(-background=>$config{colors}{background},
## 		 ($is_windows) ? () : (-width=>9));
  #BindMouseWheel($t);
  #&disable_mouse3($t->Subwidget('rotext'));
  foreach my $r (7 .. $config{plot}{nindicators}+6) {
    $extra[$r] = ["", " ", " "];
    my $rr = $r-6;
    $t -> Label(-text=>$rr.":", -foreground=>$config{colors}{activehighlightcolor})
      -> grid(-row=>$r, -column=>0, -ipadx=>3);
    $t -> Label(-textvariable=>\$extra[$r][1],
		-width=>3)
      -> grid(-row=>$r, -column=>1);
    my $this = $t -> Entry(-width	    => 10,
			   -textvariable    => \$extra[$r][2],
			   -validate	    => 'key',
			   -validatecommand => [\&set_opparam, "extra"],
			  )
      -> grid(-row=>$r, -column=>2);
    $extra[$r][0] = $t -> Button(@pluck_button, @pluck, -command=>sub{&indicator_pluck($r)})
      -> grid(-row=>$r, -column=>3);
  };
};
sub indicator_pluck {
  my $which = $_[0];
  Error("You have not made a plot yet."), return 0 unless ($last_plot);

  Echo("Select a point from the plot...");
  my ($cursor_x, $cursor_y) = (0,0);
  $extra[$which][0] -> grab();
  $paths{data0}->dispose("cursor(crosshair=true)\n", $dmode);
  ($cursor_x, $cursor_y) = (Ifeffit::get_scalar("cursor_x"),
			    Ifeffit::get_scalar("cursor_y"));
  $paths{data0}->dispose("\n", $dmode);
  $extra[$which][0] -> grabRelease();
  $extra[$which][1] = ($last_plot =~ /[kq]/) ? $last_plot : uc($last_plot);
  $extra[$which][2] = sprintf("%.3f", $cursor_x);
  Echo("Made an indicator at $extra[$which][2] in $extra[$which][1]");
  #$Data::Dumper::Indent = 2;
  #print Data::Dumper->Dump([\@extra], [qw(extra)]);
  #$Data::Dumper::Indent = 0;
};

sub setup_stack {
  my $frame = $widgets{plot_Sta} -> Frame(-borderwidth=>2, -relief=>'ridge')
    -> pack(-anchor=>'n', -fill=>'x', -side=>'top');
  $frame -> Label(-text=>"Stack plots",
		  -font=>$config{fonts}{bold},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -columnspan=>2, -sticky=>'ew');
  $frame -> Radiobutton(-text	  => 'Never',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[0],
			-value    => 0)
    -> grid(-row=>1, -column=>0, -columnspan=>2, -sticky=>'w');
  $frame -> Radiobutton(-text	  => 'Only chi(k)',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[0],
			-value	  => 1)
    -> grid(-row=>2, -column=>0, -columnspan=>2, -sticky=>'w');
  $frame -> Radiobutton(-text	  => 'Always',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[0],
			-value	  => 2)
    -> grid(-row=>3, -column=>0, -columnspan=>2, -sticky=>'w');
  $frame -> Label(-text => 'Starting value:',
		  -font => $config{fonts}{med},)
    -> grid(-row=>4, -column=>0, -sticky=>'e');
  $frame -> Entry(-width	=> 8,
		  -textvariable	=> \$extra[1],
		  -validate     => 'key',
		  -validatecommand => [\&set_opparam, 'extra'])
    -> grid(-row=>4, -column=>1, -sticky=>'w');
  $frame -> Label(-text => 'Increment:',
		  -font => $config{fonts}{med},)
    -> grid(-row=>5, -column=>0, -sticky=>'e');
  $frame -> Entry(-width	=> 8,
		  -textvariable	=> \$extra[2],
		  -validate     => 'key',
		  -validatecommand => [\&set_opparam, 'extra'])
    -> grid(-row=>5, -column=>1, -sticky=>'w');

  ## invert
  $frame = $widgets{plot_Sta} -> Frame(-borderwidth=>2, -relief=>'ridge')
    -> pack(-anchor=>'n', -fill=>'x', -side=>'top');
  $frame -> Label(-text=>"Invert paths",
		  -font=>$config{fonts}{bold},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0);
  $frame -> Radiobutton(-text	  => 'Never',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[4],
			-value	  => 0)
    -> grid(-row => 1, -column=>0, -sticky=>'w');
  $frame -> Radiobutton(-text	  => 'Only |chi(R)|',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[4],
			-value	  => 1)
    -> grid(-row => 2, -column=>0, -sticky=>'w');
  $frame -> Radiobutton(-text	  => '|chi(R)| and |chi(q)|',
			-font	  => $config{fonts}{med},
			-selectcolor=>$config{colors}{check},
			#-width	  => 12,
			-variable => \$extra[4],
			-value	  => 2)
    -> grid(-row=>3, -column=>0, -sticky=>'w');

  ## MDS offset
  $frame = $widgets{plot_Sta} -> Frame(-borderwidth=>2, -relief=>'ridge')
    -> pack(-anchor=>'n', -fill=>'x', -side=>'top');
  $frame -> Label(-text=>"Stack data sets",
		  -font=>$config{fonts}{bold},
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -columnspan=>2, );
  $frame -> Label(-text => 'Offset:',
		  -font => $config{fonts}{med},)
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $frame -> Entry(-width	=> 8,
		  -textvariable	=> \$extra[3],
		  -validate     => 'key',
		  -validatecommand => [\&set_opparam, 'extra'])
    -> grid(-row=>1, -column=>1, -sticky=>'w');

};


sub display_page {
  $list->anchorSet($_[0]);
  $list->selectionClear;
  $list->selectionSet($_[0]);
  $list->see($_[0]);
  &display_properties;
};

sub display_properties {
  if ($_[1] and ($_[0] !~ /^\d+$/)) { # only respond to button press events
                                      # and not button release events
    #print "button event: ", join(" ", @_), $/;
    return unless defined $_[2];
  }; # the check on $_[0] does the right thing for mouse-2
  if (ref($paths{$current}) =~ /Ifeffit/) {
    &read_titles($current) if ($current =~ /data\d+(\.\d+)?$/);

    ## some chores to be done when clicking away from a feff calc
    if ($paths{$current}->type eq 'feff') {
      ## remember scrollbar positions in feff.inp and interpretation
      set_feff_showing($fefftabs->raised());
      ## save the atoms titles
      my $titles = $widgets{atoms_titles}->get('1.0', 'end');
      $titles =~ s/\n/<NL>/g;
      $paths{$current} -> make(atoms_titles=>$titles);
      ## save the feff.inp text
      my $feff_file = File::Spec->catfile($project_folder,
					  $paths{$current}->get('id'),
					  "feff.inp");
      $widgets{feff_inptext} -> Save($feff_file);
    } elsif ($paths{$current}->type eq 'data') {
      ##--bkg-- $paths{$current} -> make(data_showing=>$widgets{data_notebook}->raised);
    };

  };

  ## correct a hierarchy problem on windows...
  my $thelist = (ref($list) =~ m{Frame}) ? $list->Subwidget('tree') : $list;
  my $anchor = $thelist->info('anchor');
  $current = $anchor;
  return if (($current_canvas eq 'prefs') or
	     ($current_canvas eq 'histogram') or
	     ($current_canvas eq 'athena') or
	     ($current_canvas eq 'firstshell')
	    );
  foreach ($gsd_menu, $feff_menu, $paths_menu, $data_menu, $sum_menu, $fit_menu) { # , $settings_menu) {
    $_ -> configure(-state=>'normal');
  };
  $feff_menu  -> menu -> entryconfigure($_, -state=>'disabled') for (5..8, 11, 12, 13, 15, 17);
  $paths_menu -> menu -> entryconfigure($_, -state=>'disabled') for (1..3, 5..8, 10..13);
  $fit_menu   -> menu -> entryconfigure(1,  -state=>'disabled', -label=>"Restore this fit model");
  $fit_menu   -> menu -> entryconfigure($_, -state=>'disabled') for (3..8, 10..11, 14..15);
  unless ($thelist->info('hidden', $paths{$current}->data.".0")) {
    $file_menu  -> menu -> entryconfigure($_, -state=>'normal')   for ($save_index+1..$save_index+3)
  };
  ## worry about whether most recent fit had a bkg

  my $dd = $paths{$current}->data;
  my $latest = (exists $paths{$dd.".0"}) ? $paths{$dd.".0"}->get('thisfit') : 0;
  if ($latest and
      (-e File::Spec->catfile($project_folder, "fits", $paths{$latest}->get('folder'), $dd.".bkg"))) {
    $data_menu -> menu -> entryconfigure(2, -state=>'normal');
  } else {
    $file_menu -> menu -> entryconfigure($save_index+2, -state=>'disabled');
  };


  ## it is dangerous to leave focus on a widget when switching
  ## views. in that case typing while Artemis has mouse focus will
  ## result in typing in a widget out of view.  bad juju!
  $plotr_button -> focus();
  my $this_data = $paths{$current}->data;
  if ($anchor =~ /data\d+\.0(\.\d+)?$/) { # matches any fit
    $top -> Busy;
  SWITCH: {
      $opparams->packForget(), last SWITCH if ($current_canvas eq 'op');
      $gsd ->packForget(), last SWITCH if ($current_canvas eq 'gsd');
      $feff->packForget(), last SWITCH if ($current_canvas eq 'feff');
      $path->packForget(), last SWITCH if ($current_canvas eq 'path');
    };
    $logviewer->pack(-expand=>1, -fill=>'both');
    my $skip = 1 if ($current_canvas eq 'logview');
    $skip = 0 if $log_params{force};
    $current_canvas = 'logview';
    unless ($skip) {
      $log_params{param} ||= $gds[0]->name;
      &populate_logview;
    };
    map { $file_menu -> menu -> entryconfigure($_, -state=>'normal') } ($save_index..$save_index+4, $save_index+6);
    $fit_menu   -> menu -> entryconfigure($_, -state=>'normal') for (3..8, 10..11, 14..15);
    if ($anchor =~ /(data\d+)\.0.\d+$/) {   # not head of branch
      $fit_menu -> menu -> entryconfigure(1, -state=>'normal', -label=>"Restore the \"".$paths{$current}->get('lab')."\" fit model");
      ## disable save bkg menu entry if no bkg file exists
      $file_menu -> menu -> entryconfigure($save_index+2, -state=>'disabled')
	unless (-e File::Spec->catfile($project_folder, "fits", $paths{$current}->get('folder'), $1.".bkg"));
    };
    my $latest = $paths{$current}->parent;
    $latest = $paths{$latest}->get('thisfit');
##    $widgets{log_latest}  -> configure(-text=>($latest) ? $paths{$latest}->get('lab') : "");
    $widgets{log_current} -> configure(-text=>$paths{$latest}->get('lab'));
    $top -> Unbusy;
  } elsif ($anchor =~ /data\d+(\.\d+)?$/) { # matches data
    $top -> Busy;
  SWITCH: {
      $gsd ->packForget(), last SWITCH if ($current_canvas eq 'gsd');
      $feff->packForget(), last SWITCH if ($current_canvas eq 'feff');
      $path->packForget(), last SWITCH if ($current_canvas eq 'path');
      $logviewer ->packForget(), last SWITCH if ($current_canvas eq 'logview');
    };
    $opparams->pack(-expand=>1, -fill=>'both');
    $current_canvas = 'op';
    #my $this = ($current;
    #($anchor =~ /(data\d+)/) and ($this = $1);
    #$this and populate_op($this);
    populate_op($this_data);
    map { $file_menu -> menu -> entryconfigure($_, -state=>'normal') } ($save_index..$save_index+4, $save_index+6);
    #$file_menu -> menu -> entryconfigure($save_index+2, -state=>'disabled')
    #  unless (-e File::Spec->catfile($project_folder, "fits", $paths{$current}->get('folder'), $1.".bkg"));
    $top -> Unbusy;
  } elsif ($anchor eq 'gsd') {
  SWITCH: {
      $opparams->packForget(), last SWITCH if ($current_canvas eq 'op');
      $feff    ->packForget(), last SWITCH if ($current_canvas eq 'feff');
      $path    ->packForget(), last SWITCH if ($current_canvas eq 'path');
      $logviewer ->packForget(), last SWITCH if ($current_canvas eq 'logview');
    };
    $gsd->pack(-expand=>1, -fill=>'both');
    foreach ($feff_menu, $paths_menu, $fit_menu, $data_menu, $sum_menu) {
      $_ -> configure(-state=>'disabled');
    };
    map { $file_menu->menu->entryconfigure($_, -state=>'disabled') }
      ($save_index .. $save_index+3);

    $widgets{gds2_name} -> focus();
    $current_canvas = 'gsd';
  } elsif ($anchor =~ /feff\d+$/) {
  SWITCH: {
      $opparams->packForget(), last SWITCH if ($current_canvas eq 'op');
      $gsd     ->packForget(), last SWITCH if ($current_canvas eq 'gsd');
      $path    ->packForget(), last SWITCH if ($current_canvas eq 'path');
      $logviewer ->packForget(), last SWITCH if ($current_canvas eq 'logview');
    };
    $feff->pack(-expand=>1, -fill=>'both');
    $current_canvas = 'feff';
    populate_feff($current);
    map { $feff_menu  -> menu -> entryconfigure($_, -state=>'normal') } (5..8, 11, 12, 13, 11, 12, 13, 15, 17);
    map { $paths_menu -> menu -> entryconfigure($_, -state=>'normal') } (5..8, 13);
    ## disabled atoms options in theory menu if the atoms data is not present
    my $state = $fefftabs -> pagecget("Atoms", "-state");
    map { $feff_menu  -> menu -> entryconfigure($_, -state=>$state) } (10 .. 13);
  } elsif ($anchor =~ /feff\d+\.\d+$/) {
  SWITCH: {
      $opparams->packForget(), last SWITCH if ($current_canvas eq 'op');
      $gsd     ->packForget(), last SWITCH if ($current_canvas eq 'gsd');
      $feff    ->packForget(), last SWITCH if ($current_canvas eq 'feff');
      $logviewer ->packForget(), last SWITCH if ($current_canvas eq 'logview');
    };
    $path->pack(-expand=>1, -fill=>'both');
    $current_canvas = 'path';
    populate_path($current);
    map { $feff_menu  -> menu -> entryconfigure($_, -state=>'normal') } (5..8, 11, 12, 13, 15, 17);
    map { $paths_menu -> menu -> entryconfigure($_, -state=>'normal') } (1..3, 5..8, 10..13);
    $paths_menu -> menu -> entryconfigure(3, -state=>'normal') if $n_feff;
    #$show_menu  -> menu -> entryconfigure(3, -state=>'normal') if $n_feff;
  };

};



sub populate_op {
  my $this = $_[0];
  next unless (ref($paths{$this}) =~ /Ifeffit/);
  return unless ($paths{$this}->get('file'));

  ##--bkg-- $widgets{data_notebook} -> raise($paths{$this}->get('data_showing'));

  ## file
  $widgets{op_file} -> configure(-state=>'normal');
  $widgets{op_file} -> delete(qw(0 end));
  $widgets{op_file} -> insert(0, basename($paths{$this}->{file}));
  $widgets{op_file} -> xview('end');;
  $widgets{op_file} -> configure(-state=>'disabled');
  ## include
  my @every = &every_data;
  my @all   = &all_data;
  my $data  = $paths{$this}->data;;
  my $label = $paths{$this}->get('lab') || ucfirst($this);
  ($label = substr($label, 0, 11)."...") if (length($label) > 11);
  ##$widgets{controls_frame} -> configure(-label=>$label);
  $widgets{op_include}  -> configure(-state=>($#every) ? 'normal' : 'disabled' );
  $paths{$this}->make(plot=>1) unless $#all; # just one group
  $widgets{op_plot}     -> configure(-state=>($#all) ? 'normal' : 'disabled' );

  ## titles
  $widgets{op_titles} -> delete(qw(1.0 end));
  $widgets{op_titles} -> insert('end', $paths{$this}->get('titles'));

  ## entry widgets
  foreach (qw(kmin kmax dk rmin rmax dr cormin epsilon_k)) {
    my $key = 'op_'.$_;
    $widgets{$key} -> configure(-validate=>'none');
    $widgets{$key} -> delete(qw(0 end));
    $widgets{$key} -> insert(0, $paths{$this}->get($_));
    $widgets{$key} -> configure(-validate=>'key');
  };
  ## text
  ##if ($n_data) {
  ##  map {$_->configure(-foreground => $config{colors}{activehighlightcolor})} @op_text;
  ##};
  ## optionmenus and checkbuttons
  $temp{op_fitspace} = $paths{$this}->get('fit_space');
  $temp{op_kwindow}  = ucfirst $paths{$this}->get('kwindow');
  ($temp{op_kwindow} eq 'Kaiser-bessel') and ($temp{op_kwindow} = 'Kaiser-Bessel');
  $temp{op_rwindow}  = ucfirst $paths{$this}->get('rwindow');
  ($temp{op_rwindow} eq 'Kaiser-bessel') and ($temp{op_rwindow} = 'Kaiser-Bessel');
  $temp{op_do_bkg}   = $paths{$this}->get('do_bkg');
  $temp{op_include}  = $paths{$this}->get('include');
  $temp{op_plot}     = $paths{$this}->get('plot');
  $temp{op_k1}       = $paths{$this}->get('k1');
  $temp{op_k2}       = $paths{$this}->get('k2');
  $temp{op_k3}       = $paths{$this}->get('k3');
  $temp{op_karb_use} = $paths{$this}->get('karb_use');
  ## arbitrary k-weight box
  $widgets{op_karb} -> configure(-state=>($temp{op_karb}) ? 'normal' : 'disabled');
  $temp{op_pcplot}   = $paths{$this}->get('pcplot');
  $temp{op_pcpath}   = (exists $paths{$paths{$this}->get('pcpath')}) ?
    $paths{$this}->get('pcpath') : 'None';
  if ($temp{op_pcpath} eq 'None') {
    $temp{op_pcpath_label} = 'None';
  } elsif (exists $paths{$temp{op_pcpath}}) {
    $temp{op_pcpath_label} = $paths{$temp{op_pcpath}}->descriptor();
  } else {
    $temp{op_pcpath_label} = 'None';
  };

  ## restock the pcpath menu with the current path list
  $widgets{op_pcpath} -> configure(-options => []);
  $widgets{op_pcpath} -> command(-label => 'None',
				 -command=>sub{$temp{op_pcpath}='None';
					       $temp{op_pcpath_label}='None';
					       project_state(0);
					       $paths{$this}->make(pcpath=>'None', do_r=>1); });
  my @paths = grep {/feff\d+\.\d+/} (&pcpath_list);
  foreach my $p (@paths) {
    next unless ($paths{$p}->data eq $this);
    my $label = $paths{$p}->descriptor();
    $widgets{op_pcpath} -> command(-label => $label,
  				   -command=>sub{$temp{op_pcpath} = $p;
						 $temp{op_pcpath_label}=$label;
						 my $data = $paths{$current}->data;
						 $paths{$data}->make(pcpath=>$p, do_r=>1);
						 my $ii = $paths{$p}->index;
						 my $pathto = $paths{$p}->get('path');
						 my $command = $paths{$p}->write_path($ii, $pathto, $config{paths}{extpp}, $stash_dir);
						 $paths{$p} -> dispose($command, $dmode);
						 project_state(0);
					       })
  };

  &nidp;

  ##--bkg--
  ## enable the background tweaking panel
  if ($paths{$this}->get('is_xmu')) {
    map {$widgets{$_} -> configure(-state=>'normal')} (qw(show_chi show_mu));

  ## fill the mu(E) tab
    foreach my $k (qw(e0 eshift kw rbkg pre1 pre2 nor1 nor2 spl1 spl2 step)) {
      my $key = "bkg_".$k;
      $widgets{$key} -> configure(-validate=>'none');
      $widgets{$key} -> delete(qw(0 end));
      $widgets{$key} -> insert(0, $paths{$this}->get($key));
      $widgets{$key} -> configure(-validate=>'key');
    };
    $temp{bkg_fixstep} = $paths{$this}->get('bkg_fixstep');
    $temp{bkg_flatten} = $paths{$this}->get('bkg_flatten');
    $temp{bkg_clamp2}  = $paths{$this}->get('bkg_clamp2');
  } else {
    1;
  };
};




sub clear_op {
  my $this = $_[0];
  return unless defined $paths{$this};
  ###!!! do i really need to be sure there is always a data0 ??
  if ($this =~ /data0$/) {
    delete $paths{$this};
    $paths{$this} = Ifeffit::Path -> new(id	 => 'data0',
					 group   => 'data0',
					 type    => 'data',
					 sameas  => 0,
					 kwindow => $config{data}{kwindow},
					 rwindow => $config{data}{rwindow},
					 family  => \%paths);
  } else {
    delete $paths{$this};
    $list->delete('entry',$this);
  };
  ## file
  $widgets{op_file} -> configure(-state=>'normal');
  $widgets{op_file} -> delete(qw(0 end));
  $widgets{op_file} -> configure(-state=>'disabled');
  $widgets{controls_frame} -> configure(-label=>'Data controls');
  ## titles
  $widgets{op_titles} -> delete(qw(1.0 end));
  foreach (qw(kmin kmax dk rmin rmax dr cormin)) {  #  epsilon_k
    my $key = 'op_'.$_;
    $widgets{$key} -> configure(-validate=>'none');
    $widgets{$key} -> delete(qw(0 end));
    $widgets{$key} -> configure(-validate=>'key');
  };
  ##map {$_->configure(-foreground=>$config{colors}{disabledforeground})} @op_text
  ##  if $n_data;
  $temp{op_kwindow}  = $config{data}{kwindow};
  $temp{op_rwindow}  = $config{data}{rwindow};
  $temp{op_fitspace} = 'R';
  $temp{op_do_bkg}   = 'no';
  $temp{op_include}  = 1;
  $temp{op_plot}     = 0;
  $temp{op_pcplot}   = 'No';
  $temp{op_k1}       = 0;
  $temp{op_k2}       = 0;
  $temp{op_k3}       = 0;
  $temp{op_karb_use} = 0;
  $temp{op_pcpath}   = 'None';
  $temp{op_pcpath_label}   = 'None';
};



sub set_opparam {
  my ($k, $entry, $prop) = (shift, shift, shift);
  ($entry =~ /^\s*$/) and ($entry = 0);	     # error checking ...
  ($entry =~ /^\s*\.\s*$/) and ($entry = 0); # a sole .
  ($entry =~ /^\s*\-\s*$/) and ($entry = 0); # a sole -
  ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
  return 1 if ($k =~ /extra/);
  return 0 if (($entry < 0) and ($k !~ /^bkg/));
  my $which;
  if ($k =~ /^bkg/)                          { $which = 'do_xmu' };
  if ($k =~ /(k(max|min|weight|window)|dk)/) { $which = 'do_r' };
  if ($k =~ /(r(max|min|window)|dr)/)        { $which = 'do_q' };
  my $this = $paths{$current}->data;
  $paths{$this} -> make($k=>$entry, $which=>1);
  my $i = get_index($this);
  unless ($k =~ /(cormin|epsilon_k)/) {
    foreach ("", ".0", ".2", ".1") { # flag data for updating
      next unless exists $paths{"data$i".$_};
      $paths{"data$i".$_} -> make($which=>1);
    };
    foreach (keys %paths) {	 # flag paths for updating
      next unless (ref($paths{$_}) =~ /Ifeffit/);
      next unless (/feff$i\.\d+/);
      $paths{$_} -> make($which=>1);
    };
  };
  if ($k =~ /cormin/) {
    foreach my $d (&all_data) {	# force cormin to be the same for all data sets
      $paths{$d} -> make(cormin=>$entry);
    };
  };
  &nidp if (($k !~ /cormin/) and ($k =~ /((km(in|ax))|(rm(in|ax)))/));
  project_state(0);
  return 1;
  ## need to flag that fit needs to be redone and that project needs
  ## to be saved
};

## change the anchor in the path list AND change the display in the
## main window, but do not change the path selection.  this is bound
## to mouse-2
sub anchor_display {
  ## this first bit swiped from HList.pm
  my $w = shift;
  my $Ev = $w->XEvent;
  delete $w->{'shiftanchor'};
  my $entry = $w->GetNearest($Ev->y, 1);
  return unless (defined($entry) and length($entry));

  $w->anchorSet($entry);
  &display_properties;
};



sub read_titles {
  my $this = $_[0] || $paths{$current}->data;
  return unless $this;
  return unless exists $paths{$this};
  return if ($current =~ /data\d+\.3$/);
  ## next line corrects a hierarchy problem on windows
  my $widg = (ref($widgets{op_titles}) =~ m{Frame}) ? $widgets{op_titles}->Subwidget('text') : $widgets{op_titles};
  $paths{$this} -> make(titles => $widg->get(qw(1.0 end)));
};



sub keyboard_up {
  if ($current_canvas eq 'gsd') {
    &gds2_update_mathexp($widgets{gds2list}, \%gds_selected);
    my $moveto = ($gds_selected{which}) ? # bottom if none selected
      $widgets{gds2list}->infoPrev($gds_selected{which}) : $#gds+1;
    $moveto ||= $#gds+1;	# wrap around to bottom
    gds2_display($moveto);
  } else {
    my $moveto = $list->infoPrev($current);
    return unless $moveto;
    $list->anchorSet($moveto);
    &display_properties;
    $list->see($moveto);
  };
};

sub keyboard_down {
  if ($current_canvas eq 'gsd') {
    &gds2_update_mathexp($widgets{gds2list}, \%gds_selected);
    my $moveto = ($gds_selected{which}) ? # top if none selected
      $widgets{gds2list}->infoNext($gds_selected{which}) : 1;
    $moveto ||= 1;		# wrap around to top
    gds2_display($moveto);
  } else {
    my $moveto = $list->infoNext($current);
    return unless $moveto;
    $list->anchorSet($moveto);
    &display_properties;
    $list->see($moveto);
  };
};

sub project_state {
  $project_saved = $_[0];
  $widgets{project_modified} -> configure(-text=>($_[0]) ?
					  "" : "modified");
  $top->update;
};



##  END OF THE MAIN WINDOW SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006, 2008 Bruce Ravel
##

###===================================================================
### GDS page, version 2
###===================================================================

## still to do:
##  1. multiple selection + functionality
##  2. separator entry (hmmmm.....)


sub make_gds2 {

  my $parent = $_[0];

  my $gds2 = $parent -> Frame(-relief=>'flat',
			      -borderwidth=>0,
			      #@window_size,
			      -highlightcolor=>$config{colors}{background});

  #$gds2 -> packPropagate(0);

  #$gds2 -> Label(-text=>"Parameters and Restraints", @title2)
  #  -> pack(-side=>'top', -anchor=>'w', -padx=>6);

  my $gds2list;
  $gds2list = $gds2 -> Scrolled("HList",
				-columns    => 4,
				-header	    => 1,
				-scrollbars => 'se',
				-background => $config{colors}{background},
				-font	    => $config{fonts}{fixed},
				-selectmode => 'extended',
				-selectbackground=>$config{colors}{selected},
				-browsecmd  => sub {&gds2_update_mathexp($gds2list, \%gds_selected);
						    &gds2_browse($gds2list, \%gds_selected)
						  },
				-command    => \&gds2_annotation,
			       )
    -> pack(-side=>'top', -expand=>1, -fill=>'both');
  $widgets{gds2list} = $gds2list;
  $gds_styles{header} = $gds2list -> ItemStyle('text',
					       -font=>$config{fonts}{small},
					       -anchor=>'w',
					       -foreground=>$config{colors}{activehighlightcolor});

  ## parameter styles
  foreach my $p (qw(guess def set restrain skip after merge)) {
    my $key = $p . "_color";
    ## normal styles
    $gds_styles{$p}      = $gds2list -> ItemStyle('text',
						  -font=>$config{fonts}{fixed},
						  -foreground=>$config{gds}{$key},
						  -selectforeground=>$config{gds}{$key},
						  -background=>($p eq 'merge') ? $config{gds}{merge_background} : $config{colors}{background});
    ## highlighted styles
    $gds_styles{$p."_h"} = $gds2list -> ItemStyle('text',
						  -font=>$config{fonts}{fixed},
						  -foreground=>$config{gds}{$key},
						  -selectforeground=>$config{gds}{$key},
						  -background=>$config{gds}{highlight});
    ## column 2 styles
    $gds_styles{$p."_n"} = $gds2list -> ItemStyle('text',
						  -font=>$config{fonts}{fixed},
						  -foreground=>$config{gds}{$key},
						  -selectforeground=>$config{gds}{$key},
						  -background=>($p eq 'merge') ? $config{gds}{merge_background} : $config{colors}{background2});
  };
  $gds_styles{sep}   = $gds2list -> ItemStyle('text',
					      -font=>$config{fonts}{fixed},
					      -background=>$config{colors}{background},
					     );
  $gds_styles{sep_n} = $gds2list -> ItemStyle('text',
					      -font=>$config{fonts}{fixed},
					      -background=>$config{colors}{background2});

  $gds2list -> Subwidget("hlist") -> headerCreate(0, -text=>"#",   -style=>$gds_styles{header},
			    -headerbackground=>$config{colors}{background},);
  $gds2list -> Subwidget("hlist") -> headerCreate(1, -text=>"   ", -style=>$gds_styles{header},
			    -headerbackground=>$config{colors}{background},);
  $gds2list -> Subwidget("hlist") -> headerCreate(2, -text=>"Name", -style=>$gds_styles{header},
			    -headerbackground=>$config{colors}{background},);
  $gds2list -> Subwidget("hlist") -> headerCreate(3, -text=>"Math Expression", -style=>$gds_styles{header},
			    -headerbackground=>$config{colors}{background},);

  $gds2list->bind('<ButtonPress-3>',\&gds2_post_menu);
  BindMouseWheel($gds2list);
  $gds2list -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $gds2list -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));

  $gds2list -> Subwidget("hlist") -> columnWidth(0, -char=>4);
  $gds2list -> Subwidget("hlist") -> columnWidth(1, -char=>3);
  $gds2list -> Subwidget("hlist") -> columnWidth(2, "");
  ##$gds2list -> Subwidget("hlist") -> columnWidth(2, -char=>12);
  ##$gds2list -> Subwidget("hlist") -> columnWidth(3, -char=>37);


  $widgets{gds2_show} =
    $gds2 -> Button(-text=>'Show editing area', @button2_list, -width=>1,
		    -command=>sub{$widgets{gds2_show}->packForget;
				  $widgets{gds2_editarea}->pack(-side=>=>'top', -fill=>'x', -padx=>4, -pady=>2);
				  $gds_selected{showing}="edit";});

  $widgets{gds2_editarea} = $gds2 -> LabFrame(-label=>'Edit selected parameter',
					     -foreground=>$config{colors}{activehighlightcolor},
					     -labelside=>'acrosstop' )
    -> pack(-side=>'top', -fill=>'x', -padx=>4, -pady=>2);

  ## presentation of name and math expression
  my $fr = $widgets{gds2_editarea} -> Frame()
    -> pack(-side=>=>'top', -expand=>1, -fill=>'both');
  $widgets{gds2_name} = $fr -> Entry(-width=>10, -textvariable=>\$gds_selected{name})
    -> pack(-side=>'left', -padx=>4);
  $fr -> Label(-text=>'=')
    -> pack(-side=>'left');
  $widgets{gds2_mathexp} = $fr -> Entry(-width=>10, -textvariable=>\$gds_selected{mathexp})
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>4);

  $widgets{gds2_name}    -> bind("<KeyPress-Return>", sub{gds2_define($gds2list, \%gds_selected);
							  $widgets{gds2_mathexp}->focus();
							  $widgets{gds2_mathexp}->icursor('end');
							});
  $widgets{gds2_mathexp} -> bind("<KeyPress-Return>", sub{gds2_define($gds2list, \%gds_selected)});


  ## radio buttons for setting parameter type
  $fr = $widgets{gds2_editarea} -> Frame()
    -> pack(-side=>=>'top', -expand=>1, -fill=>'both');
  foreach (qw(Guess Def Set Skip Restrain After)) {
    $widgets{"gds2_$_"} = $fr -> Radiobutton(-text=>$_,
					     -value=>lc($_),
					     -selectcolor=>$config{colors}{check},
					     -variable=>\$gds_selected{type},
					     -command=>\&gds2_alter)
      -> pack(-side=>'left', -fill=>'x', -expand=>1);
  };

  ## command buttons
  $fr = $widgets{gds2_editarea} -> Frame()
    -> pack(-side=>=>'top', -expand=>1, -fill=>'both');
  $fr -> Button(-text=>'Undo edit', @button2_list, -width=>1,
		-command=>sub{gds2_browse($gds2list, \%gds_selected)})
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2);
  $fr -> Button(-text=>'New', @button2_list, -width=>1,
		-command=>\&gds2_new)
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2);
  $widgets{gds2_grab} = $fr -> Button(-text=>'Grab', @button2_list,
				      -width=>1,
				      -state=>'disabled',
				      -command=>sub{grab_gds2($gds2list, \%gds_selected)})
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2);
  $fr -> Button(-text=>'Discard', @button2_list, -width=>1,
		-command=>\&gds2_discard)
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2);
  $fr -> Button(-text=>'Hide', @button2_list, -width=>1,
		-command=>sub{$widgets{gds2_editarea}->packForget;
			      $widgets{gds2_show}->pack(-side=>=>'top', -fill=>'x', -padx=>2, -pady=>2);
			      $gds_selected{showing}="show";})
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2);

  $widgets{help_gds} =
    $widgets{gds2_editarea}
      -> Button(-text=>"Document: Guess, Def, Set",  @button2_list,
		-command=>sub{pod_display("artemis_gds.pod")} )
    -> pack(-side=>'bottom', -fill=>'x', -padx=>2);

  if ($config{gds}{start_hidden}) {
    $widgets{gds2_editarea}->packForget;
    $widgets{gds2_show}->pack(-side=>=>'top', -fill=>'x', -padx=>2, -pady=>2);
    $gds_selected{showing}="show";
  };

  Echo("Showing new GDS page");
  $top -> update;
  return $gds2;
};

sub gds2_display {
  $widgets{gds2list} -> selectionClear;
  $widgets{gds2list} -> selectionSet($_[0]);
  $widgets{gds2list} -> anchorSet($_[0]);
  gds2_browse($widgets{gds2list}, \%gds_selected);
  $widgets{gds2list} -> see($_[0]);
};

## this is the callback for clicking on an item in the list
sub gds2_browse {
  my ($list, $rhash) = @_;
  my $wh = $list->info('anchor');
  my $which = (ref($wh) eq 'ARRAY') ? $$wh[0] : $wh;
  my $type = $list->itemCget($which, 1, '-text') || "";
  my $is_sep = ($type =~ /^\-/);
  $$rhash{which}   = $which;
  $$rhash{name}    = ($is_sep) ? "" : $list->itemCget($which, 2, '-text');
  $$rhash{mathexp} = ($is_sep) ? "" : $list->itemCget($which, 3, '-text');
 S: {
    $$rhash{type} = 'guess',    last S if ($type =~ /^g/);
    $$rhash{type} = 'def',      last S if ($type =~ /^d/);
    $$rhash{type} = 'set',      last S if ($type =~ /^s/);
    $$rhash{type} = 'restrain', last S if ($type =~ /^r/);
    $$rhash{type} = 'skip',     last S if ($type =~ /^\s*$/);
    $$rhash{type} = 'after',    last S if ($type =~ /^a/);
    $$rhash{type} = 'merge',    last S if ($type =~ /^m/);
    $$rhash{type} = 'sep',      last S if $is_sep;
  };
  $widgets{gds2_grab} -> configure(-state=>($$rhash{type} eq 'guess') ? 'normal' : 'disabled');
  if ($is_sep) {
    map {$widgets{"gds2_$_"}    -> configure(-state=>'disabled')}
      (qw(name mathexp Guess Def Set Skip Restrain After));
  } else {
    map {$widgets{"gds2_$_"}    -> configure(-state=>'normal')}
      (qw(name mathexp Guess Def Set Skip Restrain After));
    $widgets{gds2_mathexp} -> focus();
  };
  Echo($gds[$which-1]->note) if ($current_canvas eq 'gsd');
};


sub gds2_new {
  &gds2_update_mathexp($widgets{gds2list}, \%gds_selected);
  $widgets{gds2list}->selectionClear;
  $widgets{gds2list}->anchorClear;
  $gds_selected{type}    = "";
  $gds_selected{name}    = "";
  $gds_selected{mathexp} = "";
  $gds_selected{which}   = 0;
  $widgets{gds2_name} -> focus();
};


sub gds2_exists {
  foreach (@gds) {
    return 1 if (lc($_[0]) eq lc($_->name));
  };
  return 0;
};

sub gds2_update_mathexp {
  my ($list,$rhash) = @_;
  return if ($$rhash{name} =~ /^\s*$/);
  my $i = 0;
  foreach (@gds) {
    if (lc($$rhash{name}) eq lc($_->name)) {
      $gds[$i]->make(mathexp=>$$rhash{mathexp});
      $list -> itemConfigure($i+1, 3, -text=>$$rhash{mathexp}, -style=>($gds[$i]->highlight & 2) ? $gds_styles{$$rhash{type}."_h"} : $gds_styles{$$rhash{type}});
      return;
    }
    ++$i;
  };
  return 0;
};


## this is the callback for the Define button -- make a new variable
sub gds2_define {
  my ($list, $rhash) = @_;
  $$rhash{type} ||= "guess";	# sanity checking...
  my $type = $$rhash{type};
  my $tag  = ($type eq 'skip') ? "" : substr($type, 0, 1).":";
  my $which  = $list->info('anchor');
  my $row = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  my $ip   = -1;
  $$rhash{name}    =~ s/\s//g;	# sanity checking...
  $$rhash{mathexp} =~ s/\n//g;
  Error("That math expression has mismatched parentheses!"), return if check_parens($$rhash{mathexp});
  if ($$rhash{mathexp} =~ /(\w+)\(/) {
    my $fun = $1;
    Error("\"$fun\" is not a valid function in Ifeffit!"), return
      unless ($1 =~ /^$function_regex$/);
  };
  ($$rhash{mathexp} = '0') if ($$rhash{mathexp} =~ /^\s*$/);
  Error("\"$$rhash{name}\" is not a valid parameter name!"), return
    unless ($$rhash{name} =~ /^[a-z_][a-z_0-9]*$/i);

  if ($row) {
    my $ret = &gds2_alter;
    return if ($ret == -1);
  } else {
    my $found = 0;
    map { ++$found if (lc($_->name) eq lc($$rhash{name})) } (@gds);
    Error("You already have a variable named \"$$rhash{name}\"!"), return if $found;
    push @gds, Ifeffit::Parameter->new(type=>$type,
				       name=>$$rhash{name},
				       mathexp=>$$rhash{mathexp},
				       bestfit=>$$rhash{mathexp},
				       modified=>1,
				       note=>"$$rhash{name}: ",
				       autonote=>1,
				      );
    $row = $#gds+1;
    $list -> add($row);
    $list -> itemCreate($row, 0, -text=>$row,             -style=>$gds_styles{$type});
    $list -> itemCreate($row, 1, -text=>$tag,             -style=>$gds_styles{$type});
    $list -> itemCreate($row, 2, -text=>$$rhash{name},    -style=>$gds_styles{$type."_n"});
    $list -> itemCreate($row, 3, -text=>$$rhash{mathexp}, -style=>$gds_styles{$type});
    $widgets{gds2_grab} -> configure(-state=>($$rhash{type} eq 'guess') ? 'normal' : 'disabled');
  };
  $list->see($row);
  $list->selectionSet($row);
  $list->anchorSet($row);
  project_state(0);
  $parameters_changed = 1;
  Echo("Defined the $type variable $$rhash{name} as $$rhash{mathexp}");
};


## update the currently selected parameter
sub gds2_alter {
  #my ($list, $rhash) = ;
  my $which = $widgets{gds2list}->info('anchor');
  my $row   = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  Error("That math expression has mismatched parentheses!"), return -1 if check_parens($gds_selected{mathexp});
  if ($gds_selected{mathexp} =~ /(\w+)\(/) {
    my $fun = $1;
    Error("\"$fun\" is not a valid function in Ifeffit!"), return -1 unless ($1 =~ /^$function_regex$/);
  };
  my $found = 0;
  my $r = $row || 0;
  foreach my $i (0..$r-2, $r..$#gds) { ++$found if (lc($gds[$i]->name) eq lc($gds_selected{name})) };
  Error("There is another variable named \"$gds_selected{name}\"!"), return -1 if $found;
  my $type = $gds_selected{type};
  my $tag  = ($type eq 'skip') ? "" : substr($type, 0, 1).":";
  gds2_define($widgets{gds2list}, \%gds_selected), return 0 unless $row;
  my $ip = $row-1;
  $gds[$ip]->make(type	   => $type,
		  name	   => $gds_selected{name},
		  mathexp  => $gds_selected{mathexp},
		  bestfit  => $gds_selected{mathexp},
		  modified => 1);
  $widgets{gds2list}  -> itemConfigure($row, 0, -text=>$row,             -style=>$gds_styles{$type});
  $widgets{gds2list}  -> itemConfigure($row, 1, -text=>$tag,             -style=>$gds_styles{$type});
  $widgets{gds2list}  -> itemConfigure($row, 2, -text=>$gds_selected{name},    -style=>($gds[$ip]->highlight & 1) ? $gds_styles{$type."_h"} : $gds_styles{$type."_n"});
  $widgets{gds2list}  -> itemConfigure($row, 3, -text=>$gds_selected{mathexp}, -style=>($gds[$ip]->highlight & 2) ? $gds_styles{$type."_h"} : $gds_styles{$type});
  $widgets{gds2_grab} -> configure(-state=>($gds_selected{type} eq 'guess') ? 'normal' : 'disabled');
  project_state(0);
  $parameters_changed = 1;
  return 0;
};


## callback for Grab button on the GDS page -- this queries Ifeffit
## for the best fit value of a guess variable
sub grab_gds2 {
  my ($list, $rhash) = @_;
  my $which = $list->info('anchor');
  my $row   = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  my $ip = $row-1;
  Error($gds[$ip]->name." is not a guess!"), return unless ($gds[$ip]->type eq 'guess');
  Error("You have not yet run a fit!"), return if ($gds[$ip]->error =~ /^\s*$/);
  (my $best = $gds[$ip]->bestfit) =~ s/ \(.*\)//;
  $$rhash{mathexp} = "$best (" . $gds[$ip]->error . ")";
  $gds[$ip]->make(mathexp=>$$rhash{mathexp});
  &gds2_alter;
};


sub grab_all_best_fits {
  foreach my $p (@gds) {
    next unless ($p->type eq 'guess');
    (my $best = $p->bestfit) =~ s/ \(.*\)//;
    $p->make(mathexp=>"$best (" . $p->error . ")");
  };
  my $which = $widgets{gds2list} -> selectionGet();
  my $current = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  repopulate_gds2();
  if ($current) {
    $widgets{gds2list} -> selectionSet($current);
    $widgets{gds2list} -> anchorSet($current);
  };
  $top -> update;
  project_state(0);
  $parameters_changed = 1;
};


## convert all guesses to sets
sub gds2_guess_to_set {
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Are you quite sure you want to convert all guesses to sets?",
		   -title          => 'Artemis: Verifying...',
		   -buttons        => [qw/Convert Cancel/],
		   -default_button => 'Cancel',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $response = $dialog->Show();
  Echo("Leaving guesses intact."), return if ($response eq 'Cancel');
  Echo("Changing guesses to sets ...");
  foreach my $p (@gds) {
    next unless ($p->type eq 'guess');
    $p->make(type=>"set");
  };
  my $which   = $widgets{gds2list} -> selectionGet();
  my $current = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  repopulate_gds2();
  if ($current) {
    $widgets{gds2list} -> selectionSet($current);
    $widgets{gds2list} -> anchorSet($current);
  };
  $top -> update;
  project_state(0);
  $parameters_changed = 1;
  Echo("Changing guesses to sets ... done!");
};


sub gds2_def_to_other {
  my ($changeto, $rlist) = @_;
  foreach my $n (@$rlist) {
    foreach my $p (@gds) {
      next unless (lc($p->name) eq lc($n));
      $p->make(type=>$changeto);
    };
  };
  repopulate_gds2();
  project_state(0);
  $parameters_changed = 1;
};

## make a copy of the anchored parameter
sub gds2_copy {
  my $which = $widgets{gds2list} -> info('anchor') - 1;
  my $count = 1;
  my $orig  = $gds[$which]->name;
  my $name  = join("", $orig, "_c", $count);
  my $ok    = 0;
  while (not $ok) {		# find a unique name
    $ok = 1;
  LOOP: foreach my $g (@gds) {
      if (lc($g->name) eq lc($name)) {
	$ok = 0;
	$name = join("", $orig, "_c", ++$count);
	last LOOP;
      };
    };
  };
  splice(@gds, $which, 1, $gds[$which],
	 Ifeffit::Parameter->new(type	  => $gds[$which]->type,
				 name	  => $name,
				 mathexp  => $gds[$which]->mathexp,
				 bestfit  => 0,
				 modified => 1,
				 note	  => "$name: ",
				 autonote => 1,
				));
  repopulate_gds2();
  project_state(0);
  $parameters_changed = 1;
  $which+=2;
  &gds2_display($which);
  $widgets{gds2_name} -> focus;
  $widgets{gds2_name} -> selectionRange(0, 'end');
  Echo("Made a copy of parameter \"$orig\".  You may wish to rename it.");
};

## annotate the anchored parameter
sub gds2_annotation {
  my $which	 = $widgets{gds2list}->info('anchor');
  my $row	 = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  my $ip	 = $row-1;
  ## return if ($gds[$ip]->type eq 'sep');
  my $annotation = $gds[$ip]->note;
  my $prior	 = $gds[$ip]->note;
  my $label	 = ($gds[$ip]->type eq 'sep') ?
    "Annotate this separator : " : "Describe : " . $gds[$ip]->name;
  my $dialog	 = get_string($dmode, $label, \$annotation);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  return if ($annotation eq $prior); # unchanged
  if ($gds[$ip]->type eq 'sep') {
    $gds[$ip]->make(note=>$annotation);
    my $n = 17 - length($annotation);
    ($annotation .= " " . "-" x $n) if ($n > 0);
    $gds[$ip]->make(mathexp=>"----- " . $annotation . "---");
    repopulate_gds2();
  } else {
    ## turn off automatic annotation in favor of the user supplied one
    $gds[$ip]->make(note=>$annotation, autonote=>0);
    ## turn automatic annotation back on if $annotation is blank
    $gds[$ip]->make(autonote=>1) if ($annotation =~ /^\s*$/);
  };
  project_state(0);
  Echo($annotation) if ($current_canvas eq 'gsd');
}


## insert all parameters in @gds into the list on the GDS page
sub populate_gds2 {
  my $i = 1;
  foreach my $p (@gds) {
    my $type = $p->type;
    my $tag  = ($type eq 'skip') ? "" : substr($type, 0, 1).":";
    ($tag = "--") if ($type eq 'sep');
    $widgets{gds2list} -> add($i);
    $widgets{gds2list} -> itemCreate($i, 0, -text=>$i,          -style=>$gds_styles{$type});
    $widgets{gds2list} -> itemCreate($i, 1, -text=>$tag,        -style=>$gds_styles{$type});
    $widgets{gds2list} -> itemCreate($i, 2, -text=>$p->name,    -style=>($p->highlight & 1) ? $gds_styles{$type."_h"} : $gds_styles{$type."_n"});
    $widgets{gds2list} -> itemCreate($i, 3, -text=>$p->mathexp, -style=>($p->highlight & 2) ? $gds_styles{$type."_h"} : $gds_styles{$type});
    ++$i;
  };
  $gds_selected{which} ||= 1;
};

sub clear_gds2 {
  $widgets{gds2list} -> delete('all');
  $gds_selected{which} = 0;
};

sub repopulate_gds2 {
  my $which = $gds_selected{which};
  clear_gds2();
  populate_gds2();
  $gds_selected{which} = ($which <= $#gds+1) ? $which : 1;
  if (@gds) {
    $gds_selected{which} ||= 1;
    gds2_display($gds_selected{which});
  };
};



## no not make a new set of autoparams if this is a cloned feff calc
## force all autoparams to be set if this is an older project that
## does not contain autoparams
sub autoparams_define {
  my ($id, $n, $is_clone, $force_set) = @_;
  my @roman_lower = ("", qw(ii iii iv v vi vii viii ix x xi xii xii xiv xv
			    xvi xvii xviii xix xx xxi xxii xxiii xxiv xxv xxvi));
  my @roman_upper = ("", qw(II III IV V VI VII VIII IX X XI XII XII XIV XV
			    XVI XVII XVIII XIX XX XXI XXII XXIII XXIV XXV XXVI));
  my $tag = "_" . $n;
 INC: {
    $tag = "",                     last INC if ($n == 0);
    $tag = "_" . $n,               last INC if ($n > 26);
    last INC if $config{autoparams}{data_increment} eq 'numbers';
    $tag = "_" . chr(96+$n),       last INC
      if $config{autoparams}{data_increment} eq 'letters';
    $tag = "_" . chr(64+$n),       last INC
      if $config{autoparams}{data_increment} eq 'LETTERS';
    $tag = "_" . $roman_lower[$n], last INC
      if $config{autoparams}{data_increment} eq 'roman';
    $tag = "_" . $roman_upper[$n], last INC
      if $config{autoparams}{data_increment} eq 'ROMAN';
  };
  my @list = ();
  foreach my $p (qw(s02 e0 delr sigma2 ei third fourth)) {
    my $this = $config{autoparams}{$p} . $tag;
    push @list, ($config{autoparams}{$p}) ? $this : "";
    next if (gds2_exists($this)); # do nothing else if this vble already exists
    next unless $config{autoparams}{$p};
    my $value = "0";
    ($value = "1")     if ($p eq 's02');
    ($value = "0.003") if ($p eq 'sigma2');
    my $type = ($force_set) ? 'set' : $config{autoparams}{$p.'_type'};
    jump_to_variable($this, $type, 1, $value) unless $is_clone;
  };
  return @list;
};


## actually just flag them all as updated, this will force artemis to
## read from the GDS page rather than from ifeffit
sub reset_all_variables {
  foreach (@gds) { $_->make(modified => 1) };
  Echo("The initial guesses for all variables will be used rather than the best fit values the next time they are needed.");
};


sub clear_all_variables {
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Are you quite sure you want to discard all your variables?",
		   -title          => 'Artemis: Verifying...',
		   -buttons        => [qw/Discard Cancel/],
		   -default_button => 'Cancel',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $response = $dialog->Show();
  Echo("Not discarding variables"), return if ($response eq 'Cancel');
  clear_gds2();
  $#gds = -1;
  project_state(0);
  $parameters_changed = 1;
  $widgets{gds2_grab}    -> configure(-state=>"disabled");
  $widgets{gds2_name}    -> configure(-text=>"");
  $widgets{gds2_mathexp} -> configure(-text=>"");
  $widgets{gds2_name}    -> focus();
  Echo("Discarded all variables.");
};


sub gds2_discard {
  my @which = $widgets{gds2list} -> selectionGet();
  my $this  = $which[0] - 1;
  my $name = ($#which > 0) ? "these parameters" : $gds[$this]->name;
  ($name = "this separator") if (($#which == 0) and ($gds[$this]->type eq 'sep'));
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Do you really want to discard $name?",
		   -title          => 'Artemis: Verifying...',
		   -buttons        => [qw/Discard Cancel/],
		   -default_button => 'Cancel',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $response = $dialog->Show();
  Echo("Not discarding $name"), return if ($response eq 'Cancel');
  my $count = 0;
  foreach my $w (@which) {
    my $this  = $w - 1 - $count;
    splice(@gds, $this, 1);
    ++$count;
  };
  repopulate_gds2();
  $widgets{gds2_mathexp} -> focus();
  project_state(0);
  $parameters_changed = 1;
  $name =~ s/these parameters/several parameters/;
  Echo("Discarded $name");
};


## highlight parameters and mathexps that match a regex
sub gds2_highlight {
  my $regex;
  my $dialog = get_string($dmode, "Highlight all parameters matching",
			  \$regex, \@gds_regex);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Highlight aborted"), return unless $regex;
  &gds2_clear_highlights;
  my $re;
  my $is_ok = eval '$re = qr/$regex/i';
  Error("Oops!  \"$regex\" is not a valid regular expression"), return unless $is_ok;
  foreach my $i (0 .. $#gds) {
    next if ($gds[$i]->type eq 'sep');
    if ($gds[$i]->name =~ $re) {
      $gds[$i]->highlight(1);	# toggle the name bit
      my $type = $gds[$i]->type . "_h";
      $widgets{gds2list}->itemConfigure($i+1, 2, -style=>$gds_styles{$type});
    };
    if ($gds[$i]->mathexp =~ $re) {
      $gds[$i]->highlight(2);	# toggle the mathexp bit
      my $type = $gds[$i]->type . "_h";
      $widgets{gds2list}->itemConfigure($i+1, 3, -style=>$gds_styles{$type})
    };
  };
  push @gds_regex, $regex;
  Echo("Highlighted all parameters and math expressions matching /$regex/");
};

sub gds2_clear_highlights {
  foreach my $i (0 .. $#gds) {
    $gds[$i]->make(highlight=>0);
    my $type = $gds[$i]->type;
    $widgets{gds2list}->itemConfigure($i+1, 2, -style=>$gds_styles{$type."_n"});
    $widgets{gds2list}->itemConfigure($i+1, 3, -style=>$gds_styles{$type});
  };
};


sub gds2_move {
  my $which = $_[0];
  my $where = "";
  my $whch = $widgets{gds2list}->info('anchor');
  my $row   = (ref($whch) eq 'ARRAY') ? $$whch[0] : $whch;
  my $ip    = $row-1;
  if (($which eq 'before') or ($which eq 'after')) {
    my $label = "Move " . $gds[$ip]->name . " $which (name or number): ";
    my $dialog = get_string($dmode, $label, \$where);
    $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
    return unless ($where);
  } elsif ($which eq 'up') {
    return if ($ip == 0);
    $where = $row - 1;
    $which = 'before';
  } elsif ($which eq 'down') {
    return if ($ip == $#gds);
    $where = $row + 1;
    $which = 'after';
  };

  ## have the target, identify location in @gds array
  my $target = -1;
  if ($where =~ /^\d+$/) {	# target was a parameter index
    $target = $where-1;
    ($target = $#gds) if ($target > $#gds);
    ($target = 0)     if ($target < 0);
  } else {			# target was a parameter name
    foreach my $i (0..$ip-1, $ip+1..$#gds) {
      ($target = $i), last if (lc($gds[$i]->name) eq lc($where));
    };
  };
  Error("\"$where\" is not in the parameter list.\""), return if ($target == -1);

  --$target if ($ip < $target);
  my $save = splice(@gds, $ip, 1);
  if ($which eq 'before') {
    @gds = (@gds[0..$target-1], $save, @gds[$target..$#gds]);
    $target += 1;
  } elsif ($which eq 'after')  {
    @gds = (@gds[0..$target], $save, @gds[$target+1..$#gds]);
    $target += 2;
  };
  repopulate_gds2();
  gds2_display($target);
  $widgets{gds2_mathexp} -> focus();
};


sub gds2_find {
  my $whch  = $widgets{gds2list}->info('anchor');
  my $row   = (ref($whch) eq 'ARRAY') ? $$whch[0] : $whch;
  my $ip    = $row-1;
  my $which = $gds[$ip]->name;
  my $message = "";

  ## check for this variable's use in all def, set, and restraints
  ## make sure the gsd data structures are up to date
  my @all = map { $_->name } @gds;

  foreach my $p (@gds) {
    ($message .= "\tthe def parameter ".$p->name."\n") if
      (($p->type eq 'def') and ($p->mathexp =~ /(^|\W)$which($|\W)/i));
    ($message .= "\tthe set parameter ".$p->name."\n") if
      (($p->type eq 'set') and ($p->mathexp =~ /(^|\W)$which($|\W)/i));
    ($message .= "\tthe restraint ".$p->name."\n") if
      (($p->type eq 'restrain') and ($p->mathexp =~ /(^|\W)$which($|\W)/i));
  };


  ## check for the parameter's use in all math expressions
  my @paths = grep /feff\d+\.\d+/, keys(%paths);	# fetch path list
  foreach my $f (&path_list) {
    next unless (ref($paths{$f}) =~ /Ifeffit/);
    next unless ($paths{$f}->type eq 'path');
    my $descriptor = $paths{$f}->descriptor();
    foreach my $p (qw(s02 e0 delr sigma^2 ei 3rd 4th dphase k_array phase_array amp_array)) {
      ($message .= "\tthe $p of $descriptor\n") if
	($paths{$f}->get($p) =~ /(^|\W)$which($|\W)/i);
    };
  };

  Error("\"$which\" is not used in any math expression."), return
    unless $message;
  $message = "The parameter \"$which\" is used in:\n\n" . $message;
  post_message($message, "Use of $which");

};



## normally this is called from t he context menu in the GDS list.
## The arguments allow this to be called as part of an import
## of a feffit.inp file
sub gds2_search_replace {
  my ($specified, $replacement) = @_;;
  my $whch  = $specified || $widgets{gds2list}->info('anchor');
  my $row   = (ref($whch) eq 'ARRAY') ? $$whch[0] : $whch;
  my $ip    = $row-1;
  my $which = $gds[$ip]->name;

  my $label   = "New name for parameter \"$which\": ";
  my $newname = $replacement || $which;
  if (not $replacement) {
    my $dialog  = get_string($dmode, $label, \$newname, \@rename_buffer);
    $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
    Echo("Not renaming ". $which), return if ($which eq $newname);
    Echo("Not renaming ". $which), return if ($newname =~ /^\s*$/);
  };
  Error("There is already a parameter called \"$newname\""), return if (grep {$_->name() =~ /^$newname$/} @gds);

  $gds[$ip] -> make(name => $newname);
  foreach my $p (@gds) {
    if ($p->mathexp =~ /\b$which\b/) {
      my $me = $p->mathexp;
      $me =~ s/\b$which\b/$newname/g;
      $p -> make(mathexp => $me);
    };
  };

  foreach my $f (&path_list) {
    next unless (ref($paths{$f}) =~ /Ifeffit/);
    next unless ($paths{$f}->type eq 'path');
    foreach my $p (qw(s02 e0 delr sigma^2 ei 3rd 4th dphase k_array phase_array amp_array)) {
      my $me = $paths{$f}->get($p);
      if ($me =~ /\b$which\b/) {
	$me =~ s/\b$which\b/$newname/g;
	$paths{$f} -> make($p => $me);
      };
    };
  };

  repopulate_gds2();
  project_state(0);
  Echo("Renamed \"$which\" as \"$newname\" and replaced it throughout the project.");
};

sub gds2_locate {
  my $label = "Name of variable to locate: ";
  my $name = "";
  my $dialog = get_string($dmode, $label, \$name);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  return if ($name =~ /^\s*$/);
  my $found = -1;
  my $i = 0;
  foreach my $p (@gds) {
    next if ($p->type eq 'sep');
    ($found = $i), last if (lc($p->name) eq lc($name));
    ++$i;
  };

  Error("You don't have a variable called \"$name\""), return if ($found == -1);
  gds2_display($found+1);
};


sub gds2_show {
  my $string = "";

  $notes{messages} -> delete(qw(1.0 end));
  my $len = 0;
  foreach (@gds) {
    ($len = length($_->name)) if (length($_->name) > $len);
  };
  my $sep = "-" x ($len+25);
  $len = '%-' . $len . "s";
  foreach (@gds) {
    if ($_->type eq 'sep') {
      $notes{messages} -> insert('end', "-" x 9);
    } else {
      $notes{messages} -> insert('end', sprintf("%-8s ", $_->type), $_->type);
    };
    if ($_->type eq 'skip') {
      $notes{messages} -> insert('end', sprintf($len, $_->name), 'skip');
      $notes{messages} -> insert('end', sprintf(" = %s\n", $_->mathexp), 'skip');
    } elsif ($_->type eq 'guess') {
      $notes{messages} -> insert('end', sprintf($len, $_->name), 'guess2');
      $notes{messages} -> insert('end', sprintf(" = %s\n", $_->mathexp), 'guess2');
    } elsif ($_->type eq 'sep') {
      $notes{messages} -> insert('end', $sep . "\n");
    } else {
      $notes{messages} -> insert('end', sprintf($len, $_->name));
      $notes{messages} -> insert('end', sprintf(" = %s\n", $_->mathexp));
    };
  };
  $notes{messages} -> yviewMoveto(0);
  $top -> update;
  raise_palette('messages');
};



sub gds2_up {
  return unless ($current_canvas eq 'gsd');
  gds2_move('up');
};
sub gds2_down {
  return unless ($current_canvas eq 'gsd');
  gds2_move('down');
};

sub gds2_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
  my @which = $w->selectionGet();
  $w->anchorSet($entry);
  my $clicked = $w->info('anchor');

  if (grep {/^$clicked$/} @which) {
    ## right click within the current extended selection
    1;
  } else {
    ## right clicked outside the current extended selection
    $w->selectionClear;
    $w->selectionSet($entry);
    @which = $w->selectionGet();
  };
  gds2_browse($w, \%gds_selected);

  ## post the message with parameter-appropriate text
  my ($name, $index, $type);
  if ($#which > 0) {
    $index = $w->info('anchor') - 1;
    $name = "these parameters";
    $type = 'extended';
  } else {
    $index = $which[0] - 1;
    $name = '"'.$gds[$index]->name.'"';
    $type = $gds[$index]->type;
  };
  return if ($gds[$index]->type eq 'sep');
  my $anchor = '"'.$gds[$index]->name.'"';
  my ($X, $Y) = ($Ev->X, $Ev->Y);
  ## my $isare = ($#which>0) ? "are" : "is";
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[
		      (($gds_selected{showing} eq 'show') ?
		       ([ command=>"Edit $anchor",
			 #-state  =>($#which>0) ? 'disabled' : 'normal',
			 -command=>sub{$widgets{gds2_show}->packForget;
				       $widgets{gds2_editarea}->pack(-side=>=>'top', -fill=>'x', -padx=>4, -pady=>2);
				       $gds_selected{showing}="edit";}],
		       ) :
		       ()),
		      [ cascade=>"Make $name ...",
		       -tearoff=>0,
		       -menuitems=>[
				    [ command => "guess",
				     -command => [\&gds2_make, 'guess']],
				    [ command => "def",
				     -command => [\&gds2_make, 'def']],
				    [ command => "set",
				     -command => [\&gds2_make, 'set']],
				    [ command => "skip",
				     -command => [\&gds2_make, 'skip']],
				    [ command => "restraint",
				     -command => [\&gds2_make, 'restrain']],
				    [ command => "after",
				     -command => [\&gds2_make, 'after']],
				   ]],
		      [ cascade=>"Move $anchor ...",
		       -tearoff=>0,
		       #-state  =>($#which>0) ? 'disabled' : 'normal',
		       -menuitems=>[
				    [ command=>"before ...",
				      -command=>sub{gds2_move("before")}],
				    [ command=>"after ...",
				      -command=>sub{gds2_move("after")}],
				   ]],
		      [ cascade=>"Insert separator ...",
		       -tearoff=>0,
		       ##-state  =>'disabled',
		       -menuitems=>[
		      		    [ command=>"before ...",
		      		      -command=>sub{gds2_sep("before")}],
		      		    [ command=>"after ...",
		      		      -command=>sub{gds2_sep("after")}],
		      		   ]],
		      [ command=>"Copy $anchor",
		       -command=>\&gds2_copy],
		      "-",
		      [ command=>"Build restraint from $anchor",
		       -command=>\&gds2_build_restraint,
		       -state  =>($gds[$index]->type =~ /(def|guess)/) ? 'normal' : 'disabled'],
		      [ command=>"Annotate $anchor",
		       #-state  =>($#which>0) ? 'disabled' : 'normal',
		       -command=>\&gds2_annotation],
		      [ command=>"Grab best fit for $anchor",
		       #-state=>($type eq 'guess') ? 'normal' : 'disabled'
		       -command=>sub{grab_gds2($widgets{gds2list}, \%gds_selected)},],
		      "-",
		      [ command=>"Find where $anchor is used",
		       #-state  =>($#which>0) ? 'disabled' : 'normal',
		       -command=>\&gds2_find],
		      [ command=>"Change name of $anchor globally",
		       #-state  =>($#which>0) ? 'disabled' : 'normal',
		       -command=>\&gds2_search_replace],
		      "-",
		      [ command=>"Discard $name",
		       -command=>\&gds2_discard],
		     ])
	-> Post($X, $Y);
  $w -> break;
};

sub gds2_sep {
  my $which = $widgets{gds2list} -> info('anchor') - 1;
  --$which if ($_[0] eq 'before');

  splice(@gds, $which, 1, $gds[$which],
	 Ifeffit::Parameter->new(type => "sep",));

  repopulate_gds2();
  project_state(0);
  Echo("Inserted separator $_[0] ");
};

sub gds2_build_restraint {
  my $which = $widgets{gds2list} -> info('anchor') - 1;
  my $name  = $gds[$which]->name;

  my %restraint;
  $restraint{min} = int(Ifeffit::get_scalar($name)/10) || 0;
  my $bf = $gds[$which]->bestfit; # watch out for math expressions
  ($bf =~ /-?(\d+\.?\d*|\.\d+)/) or ($bf = 0);
  $restraint{max} = int(Ifeffit::get_scalar($name)*2)  || 2*$bf || 10;
  $restraint{amp} = int(Ifeffit::get_scalar("chi_reduced")/20)*100 || 1000;


  my $db = $top -> DialogBox(-title=>"Artemis: Restraint builder",
			     -buttons=>['Build restraint', 'Cancel'],
			     -default_button=>'Build restraint');
  my $fr = $db->Frame(-borderwidth=>2, -relief=>'flat')->pack(-pady=>5);
  $fr -> Label(-text=>"Restrain \"$name\" to be within these boundaries",
	       -font=>$config{fonts}{large},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top');
  $fr = $db->Frame(-borderwidth=>2, -relief=>'groove')
    -> pack(-fill=>'x', -expand=>1, -padx=>2);
  $fr -> Label(-text=>'Minimum value:',
	       -font=>$config{fonts}{large},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'w', -pady=>2);
  $fr -> Entry(-textvariable=>\$restraint{min},
	       -width=>8)
    -> grid(-row=>0, -column=>1, -sticky=>'e', -pady=>2);

  $fr -> Label(-text=>'Maximum value:',
	       -font=>$config{fonts}{large},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'w', -pady=>2);
  $fr -> Entry(-textvariable=>\$restraint{max},
	       -width=>8)
    -> grid(-row=>1, -column=>1, -sticky=>'e', -pady=>2);

  $fr -> Label(-text=>'Amplifier:',
	       -font=>$config{fonts}{large},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'w', -pady=>2);
  $fr -> Entry(-textvariable=>\$restraint{amp},
	       -width=>8)
    -> grid(-row=>2, -column=>1, -sticky=>'e', -pady=>2);
  &posted_Dialog;
  my $answer = $db -> Show;
  return 0 if ($answer eq 'Cancel');

  push @gds, Ifeffit::Parameter->new(type     => "restrain",
				     name     => "res_".$name,
				     mathexp  => "penalty($name, $restraint{min}, $restraint{max}) * $restraint{amp}",
				     bestfit  => 0,
				     modified => 1,
				     note     => "$name: ",
				     autonote => 1);
  repopulate_gds2();
  project_state(0);
  $parameters_changed = 1;
  $which = $#gds + 1;
  &gds2_display($which);
  $widgets{gds2_name} -> focus;
  $widgets{gds2_name} -> icursor('end');
  $widgets{gds2_name} -> selectionRange(0, 'end');

  Echo("Built restraint " . $gds[-1]->name . " = " . $gds[-1]->mathexp);
};

sub gds2_make {
  my @list = $widgets{gds2list}->selectionGet;
  foreach my $w (@list) {
    gds2_display($w);
    $gds_selected{type}=$_[0];
    &gds2_alter
  }
  $widgets{gds2list}->selectionClear;
  map {$widgets{gds2list}->selectionSet($_)} @list;
};


sub gds2_keyboard_type {
  return unless ($current_canvas eq 'gsd');
  my $who = $top->focusCurrent;
  $multikey = "";
  Echo("Make parameter [gsdkra] (g=guess  s=set  d=def  k=skip  r=restraint  a=after)");
  $echo -> focus();
  $echo -> grab;
  $echo -> waitVariable(\$multikey);
  $echo -> grabRelease;
  $who -> focus;
  Echo("$multikey is not a parameter type (guess=g  set=s  def=d  skip=k  restraint=r  after=a)"), return unless (lc($multikey) =~ /^[degksr]$/);
 SWITCH: {
    $gds_selected{type} = 'guess',    last SWITCH if (lc($multikey) eq 'g');
    $gds_selected{type} = 'def',      last SWITCH if (lc($multikey) eq 'd');
    $gds_selected{type} = 'set',      last SWITCH if (lc($multikey) eq 's');
    $gds_selected{type} = 'skip',     last SWITCH if (lc($multikey) eq 'k');
    $gds_selected{type} = 'restrain', last SWITCH if (lc($multikey) eq 'r');
    $gds_selected{type} = 'after',    last SWITCH if (lc($multikey) eq 'a');
  };
  &gds2_alter;
  Echo("Made parameter a $gds_selected{type}");
};



## various sanity checks to be done before a fit

sub verify_number_of_variables {
  my $total = 0;
  foreach my $p (@gds) {
    ++$total if ($p->type eq 'guess')
  };
  my $bkg = 0;
  foreach my $d (&all_data) {
    next unless ($paths{$d}->get('do_bkg') eq 'yes');
    my $deltak = $paths{$d}->get('kmax') - $paths{$d}->get('kmin');
    my $deltar = $paths{$d}->get('rmax') - $paths{$d}->get('rmin');
    my $this   = int( 2 * $deltak * $deltar / PI );
    ($this = 5) if ($this < 5);
    ($this = $limits{spline_knots}) if ($this > $limits{spline_knots});
    $total += $this;
    $bkg += $this;
  };
  if ($total > $limits{variables}) {
    my $string = "You have used $total guess parameters";
    $string   .= ($bkg) ? " and $bkg background parameters.\n" : ".\n";
    $string   .= "This exceeds Ifeffit's limit of $limits{variables} variable parameters.";
    return $string;
  };
  return "";
}


sub verify_parameters {
  my @params = ();
  foreach my $p (@gds) {
    push @params, lc($p->name) unless ($p->type =~ /(after|sep|skip)/);
  };
  my @def_restraint = ();
  foreach my $p (@gds) {
    push @def_restraint, lc($p->name) if ($p->type =~ /(def|restrain)/)
  }
  my $param_regex = lc(join("|", @params, '_^@_'));

  my (%not_defined, %used, %functions);
  my @unused_defs = ();
  ## look at all the path parameters ...
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'path');
    next unless ($paths{$k}->get('include'));
    my $this_data = $paths{$k}->data;
    next unless ($paths{$this_data}->get('include'));
    foreach my $p (qw(s02 e0 delr sigma^2 ei 3rd 4th dphase k_array phase_array amp_array)) {
      my $str = $paths{$k}->get($p);
      if ($str and ($str !~ /^\s+$/)) {
	$str =~ s/[ \t]+//g;	# remove spaces
	$str =~ s/\(/\( /g;	# put a space after an open paren
	foreach my $w (split(/[^a-zA-Z_0-9.\(]+/, $str)) {
	  next if (lc($w) =~ /(etok|pi|reff)/);    # special words
	  next if ($w =~ /^(\d+\.?\d*|\.\d+)$/);   # a number or float
	  next if ($w eq ""); # this happens with a leading minus sign
	  if ($w =~ /\($/) {	# this was a function, e.g. debye(
	    my $ww = lc(substr($w, 0, -1));
	    push @{$functions{$ww}}, $paths{$k}->get('lab');
	    next;
	  };
	  ## push this path onto the list of paths using this bogus variable
	  (lc($w) =~ /^($param_regex)$/) or
	    push @{$not_defined{lc($w)}}, "the $p of " . $paths{$k}->descriptor();
	  ++$used{lc($w)};	# mark it as used
	};
      };
    };
  };
  ## ... then look at all the def expressions
  foreach my $d (@def_restraint) {
    my ($type, $str);
    foreach my $p (@gds) {
      next unless (lc($p->name) eq lc($d));
      $type = $p->type;
      $str  = $p->mathexp;
      last;
    };
    #print join("|", $d, $type, $str), $/;
    if ($str and ($str !~ /^\s+$/)) {
      $str =~ s/[ \t]+//g;	# remove spaces
      $str =~ s/\(/\( /g;	# put a space after an open paren
      foreach my $w (split(/[^a-zA-Z_0-9.\(]+/, $str)) {
	next if (lc($w) =~ /(etok|pi|reff)/);    # special words
	next if ($w =~ /^(\d+\.?\d*|\.\d+)$/);   # a number or float
	next if ($w eq ""); # this happens with a leading minus sign
	if ($w =~ /\($/) {	# this was a function, e.g. debye(
	  my $ww = lc(substr($w, 0, -1));
	  push @{$functions{$ww}},
	    ($type eq 'def') ? "the def parameter \`$d\'" :
	      "the restraint \`$d\'";
	  next;
	};
	## push this path onto the list of paths using this bogus variable
	(lc($w) =~ /^($param_regex)$/) or
	  push @{$not_defined{lc($w)}},
	    ($type eq 'def') ? "the def parameter \`$d\'" :
	      "the restraint \`$d\'";
	++$used{lc($w)};	# mark it as used
      };
    };
  };
  my $message = "";
  foreach my $p (@params) {	# unused guess parameters
    next if $used{lc($p)};
    my $this;
    foreach my $pp (@gds) {
      next unless ($pp->name eq $p);
      $this = $pp;
      last;
    };
    next unless $this;
    my $choice = $this->type;
    next if ($choice =~ /(after|restrain|set)/);
    $message .= " \`$p\' was defined as a $choice but not used\n";
    push @unused_defs, $p if ($choice eq 'def');
  };
  foreach my $p (keys %not_defined) { # undefined parameters in math expressions
    $message .= " \`$p\' was not defined but was used in:\n    " .
      join("\n    ", @{$not_defined{lc($p)}});
    $message .= $/;
  };
  foreach my $f (keys %functions) { # unknown functions
    next if ($f =~ /^($function_regex)$/);
    next if ($f =~ /^\s*$/);
    $message .= " \`$f\' is not a valid Ifeffit function but was used in:\n    " .
      join("\n    ", @{$functions{lc($f)}});
    $message .= $/;
  };
  if ($message) {
    $message = "Errors in parameters and math expressions:\n\n" .
      $message .
	"\n\nRemember that set parameter are evaluated once at the\n" .
	  "beginning of the fit, def parameters are re-evaluated\n" .
	    "as the fit progresses, and after parameters are evaluated\n" .
	      "after the fit is finished.";
  };
  return ($message, \@unused_defs);
  #print "used: ", join(" ", %used), $/;
  #print "not_defined: ", join(" ", keys %not_defined), $/;
}


## see http://www.perlmonks.org/index.pl?node_id=38942
sub check_parens {
  my $count = 0;
  foreach my $c (split(//, $_[0])) {
    ++$count if ($c eq '(');
    --$count if ($c eq ')');
    return $count if $count < 0;
  };
  return $count;
};


sub verify_parens {
  my @trouble = ();
  ## check the params for balanced parens
  foreach my $p (@gds) {
    next if ($p->type =~ /s(e|ki)p/);
    my $tag = "\tthe " . $p->type . " variable " . $p->name;
    ($tag = "\tthe restraint " . $p->name) if ($p->type eq 'restrain');
    push @trouble, $tag if check_parens($p->mathexp);
  };
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'path');
    next unless ($paths{$k}->get('include'));
    foreach my $p (qw (s02 e0 delr sigma^2 ei 3rd 4th dphase k_array phase_array amp_array)) {
      next unless defined $paths{$k}->get($p);
      next if ($paths{$k}->get($p) =~ /^\s*$/);	# could be empty string
      next unless $paths{$k}->get($p); # could be 0
      my $tag = "\tthe $p for \"" . $paths{$k}->descriptor() . "\"";
      push @trouble, $tag if check_parens($paths{$k}->get($p));
    };
  };
  return "" unless @trouble;
  return "These math expressions seem to have unbalanced parentheses:\n" .
    join("\n", @trouble) .
      "\n\n";
};

sub verify_operators {
  my @trouble = ();
  my $repeats = '\+\+|\-\-|\/\/|\*\*\*|\^\^';
  foreach my $p (@gds) {
    next if ($p->type =~ /s(e|ki)p/);
    next unless ($p->mathexp =~ /($repeats)/);
    push @trouble, sprintf("\tthe %s parameter \"%s\" has: %s",
			   $p->type, $p->name, $1);
  };
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'path');
    next unless ($paths{$k}->get('include'));
    foreach my $p (qw (s02 e0 delr sigma^2 ei 3rd 4th dphase k_array phase_array amp_array)) {
      next unless defined $paths{$k}->get($p);
      my $mathexp = $paths{$k}->get($p);
      next if ($mathexp =~ /^\s*$/);	# could be empty string
      next unless $mathexp; # could be 0
      next unless ($mathexp =~ /($repeats)/);
      push @trouble, sprintf("\tthe %s expression for path \"%s\" has: %s",
			     $p, $paths{$k}->descriptor, $1);
    };
  };
  return q{} unless @trouble;
  return "These math expressions have invalid binary operators:\n" .
    join("\n", @trouble) .
      "\n\n";
};


## do not allow GDS parameters to take the names of ifeffit's program
## variables.  the $progvar_regex list are the pre-defined batch of
## program variables.  The delta_* and correl_*_* program variables
## will be generated by feffit()ing or minimize()ing.  The feff\d_\d_*
## variables are generated by get_path().  in fact the regex for that
## last one is incorrect -- it covers parts of the namespace that
## might not be used (feff087620_7652000_ei, for example), but it is a
## nice 'n' simple regex and an uncommon string for a GDS name.  note
## also that "feff\d+_\d+" matches Artemis' convention for path group
## names.
sub verify_ifeffit_program_variables {
  my $progvar_regex =		# all of feffit's pre-defined program variables
      "c(hi_(reduced|square)|or(e_width|rel_min)|ursor_[xy])"
    . "|d([kr]|ata_(set|total)|k([12]|1_spl|2_spl)|r[12])"
    . "|e(0|dge_step|psilon_[kr]|tok)"
    . "|k(m(ax(|_s(pl|uggest))|in(|_spl))|w(eight(|_spl)|indow))"
    . "|n(_(idp|varys)|column_label|knots|orm([12]|_c[012]))"
    . "|p(ath_index|i|re([12]|_(offset|slope)))"
    . "|q(max_out|sp)"
    . "|r(_factor|bkg|m(ax(|_out)|in)|sp|w(eight|in(|dow)))"
    . "|toler";
  my $path_param_regex = "d(e(gen|lr)|phase)|e[0i]|fourth|reff|s(02|igma2)|third";

  my @params = ();
  foreach my $p (@gds) {
    push @params, lc($p->name) unless ($p->type =~ /(sep|skip)/);
  };
  my $param_regex = lc(join("|", @params, '_^@_'));
  my @match = ();
  foreach my $p (@params) {
    push @match, $p if (lc($p) =~ /^($progvar_regex)$/);
    push @match, $p if (lc($p) =~ /^delta_($param_regex)$/);
    push @match, $p if (lc($p) =~ /^correl_($param_regex)_($param_regex)$/);
    push @match, $p if (lc($p) =~ /^feff\d+_\d+_($path_param_regex)$/);
  };
  return q{} unless @match;
  my $common = "One common example of this sort is a variable named \"dr1\", which\nshould be changed to something like \"dr_1\" or \"drone\".\n\n";
  if ($#match) {
    return "These parameters use names which have special meaning in Ifeffit:\n\t" .
      join("\n\t", @match) .
	"\nYou must change those parameter names before attempting to fit.\n" .
	  $common;
  } else {
    return "This parameter uses a name which has special meaning in Ifeffit:\n\t" .
      join("\n\t", @match) .
	"\nYou must change this parameter name before attempting to fit.\n" .
	  $common;
  }
};

## return a list of the number of merges and the index of the first
## merge in the list
sub count_merge {
  my $total = 0;
  my $first = 0;
  foreach my $p (@gds) {
    ++$first unless $total;
    next unless ($p->type eq 'merge');
    ++$total;
  };
  return ($total, $first);
};

sub check_idp {
  my ($nidp, $ndat, $nvar) = (0,0,0);
  foreach my $data (&all_data) {
    my $deltak = $paths{$data}->get('kmax') - $paths{$data}->get('kmin');
    my $deltar = $paths{$data}->get('rmax') - $paths{$data}->get('rmin');
    $nidp     += int( 2 * $deltak * $deltar / PI );
    ++$ndat;
  };
  foreach my $p (@gds) {
    next if ($p->name =~ /^\s*$/);
    ++$nvar if ($p->type eq 'guess');
  };
  my $s = ($ndat >1) ? "s" : q{};
  return ($nidp < $nvar) ?
    "ERROR!  You have used $nvar variables but only have $nidp independent\nmeasurements in $ndat data set$s.\n" :
      "";
};


sub gds2_import_text {
  my $path = $current_data_dir || cwd;
  my $types = [['Exported variables', '*.variables'], ['All files', '*']];
  my $file = $top -> getOpenFile(-filetypes=>$types,
				 ##(not $is_windows) ?
				 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -title => "Artemis: Import a list of variables");
  return unless ($file);
  my ($name, $feff_path, $suffix) = fileparse($file);
  $current_data_dir = $feff_path;

  my $view = $#gds+2;
  open V, $file or die "could not open $file for reading variables\n";
  while (<V>) {
    next unless (/^\s*(after|def|guess|merge|restrain|s(et|ep|kip))\b/);
    chomp;
    my @line = split(/\s*[ \t=]\s*/, $_);
    my $type = shift @line;
    my $name = shift @line;
    my $val  = join("", @line);
    $val =~ s/[!%#].*$//;	# ease puts end-of-line comments on
                                # guess lines
    my $which = -1;
    my $see = 0;
    foreach (@gds) {
      ++$see;
      $which = $_, last if ($_->name =~ /^$name$/i);
    };
    ## or for the end of the list
    if ($which == -1) {
      if ($type eq 'sep') {
	push @gds, Ifeffit::Parameter->new(type => "sep",);
      } else {
	push @gds, Ifeffit::Parameter->new(type	    => $type,
					   name	    => $name,
					   mathexp  => $val,
					   bestfit  => 0,
					   modified => 1,
					   note	    => "$name: ",
					   autonote => 1,
					  );
      };
      $see = $#gds;
      $which = $gds[$see];
      ++$see;
    };
  };
  ($view = 1) if ($view > $#gds+1);
  repopulate_gds2();
  gds2_display($view);
  display_page("gsd");
  project_state(0);
  $parameters_changed = 1;

  close V;

};


sub gds2_export_text {
  my $path = $current_data_dir || cwd;
  my $types = [['All Files', '*'],['Text Files', '*.txt']];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 ##(not $is_windows) ?
				 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialfile=>'artemis.variables',
				 -initialdir=>$path,
				 -title => "Artemis: Export a list of variables");
  return unless ($file);
  my ($name, $feff_path, $suffix) = fileparse($file);
  $current_data_dir = $feff_path;

  my $len = 0;
  foreach (@gds) {
    ($len = length($_->name)) if (length($_->name) > $len);
  };
  $len++;

  open V, '>'.$file or die "could not open $file for writing variables\n";
  print V "# List of parameters from Artemis\n";
  print V "# ", $props{'Project title'}, $/, $/;

  my $pattern = "%-9s %-" . $len . "s = %s\n";
  #print $len, " --- ", $pattern, $/;
  foreach (@gds) {
    printf V $pattern, $_->type, $_->name, $_->mathexp;
  };
  close V;
};

##  END OF THE SECTION ON THE GDS PAGE

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
## THE FEFF CALCULATION PAGE

sub make_feff {
  my $parent = $_[0];

  my $c = $parent -> Frame(-relief=>'flat',
			   -borderwidth=>0,
			   #@window_size,
			   -highlightcolor=>$config{colors}{background});

  $fefftabs = $c -> NoteBook(-backpagecolor	 => $config{colors}{background},
			     -inactivebackground => $config{colors}{inactivebackground},
			     -font		 => $config{fonts}{med},)
    -> pack(-fill => 'both', -expand=>1, -side => 'bottom');
  foreach (qw/Atoms feff.inp Interpretation/) {
    $feffcard{$_} = $fefftabs -> add($_, -label=>$_, -anchor=>'center',
				     -raisecmd=>[\&set_feff_showing, $_]
				    );
  };


  my @start = (-foreground=>$config{colors}{activehighlightcolor},
	       -font=>$config{fonts}{med});

  my $t = "";			# used for clicky help
  ##   $header{current} = $c ->
  ##     Label(@title2, -text=>"FEFF Calculation",)
  ##       -> pack(-side=>'top', -anchor=>'w', -padx=>6);

  ## atoms information
  &make_atoms($feffcard{Atoms});


  ## feff.inp file
  ##(my $fn = $config{intrp}{unimported}) =~ s/ italic//;
  my $fn = $config{fonts}{fixedsm};
  $widgets{feff_inptext} = $feffcard{'feff.inp'} ->
    Scrolled('TextUndoQuiet',
	     -scrollbars => 'se',
	     -wrap	 => 'none',
	     -font	 => $fn)
      -> pack(-side=>'top', -expand=>1, -fill=>'both', -padx=>3, -pady=>3);
  $widgets{feff_inptext} -> Subwidget("xscrollbar")
    ->configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));
  $widgets{feff_inptext} -> Subwidget("yscrollbar")
    ->configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));
  $widgets{feff_inptext} -> tagConfigure("feffinp", -font=>$fn);
  $widgets{feff_inptext} -> tagConfigure("feffwarn", -font=>$fn, -foreground=>'red3');
  BindMouseWheel($widgets{feff_inptext});

  my $bfr = $feffcard{'feff.inp'} -> Frame ()
    -> pack(-side=>'bottom', -fill=>'x');

  $widgets{help_runfeff} =
    $bfr -> Button(-text=>"Document: Feff and it's input file",  @button2_list,
		   -command=>sub{pod_display("artemis_feffinp.pod")},
		   -width=>1)
	-> pack(-side=>'right', -fill=>'x', -expand=>1, -padx=>2, -pady=>2);

  $widgets{feff_run} = $bfr -> Button(-text=>'Run Feff', @button2_list,
				      -command => sub{&run_feff($current)},
				      -width=>1)
    -> pack(-side=>'left', -fill=>'x', -expand=>1, -padx=>2, -pady=>2);



  ## Interpretation of Feff calculation

  ##   $t = $feffcard{Interpretation} ->
  ##     Button(@start, -activeforeground=>$config{colors}{mbutton},
  ## 	   -text=>'Interpretation of the FEFF calculation',
  ## 	   -relief=>'flat', -borderwidth=>0,
  ## 	   -command=>[\&Echo, $click_help{'Interpretation of the FEFF calculation'}])
  ##       -> pack(-side=>'top', -anchor=>'c');

  $widgets{feff_intrp_headerbox} = $feffcard{Interpretation} ->
    LabFrame(-label=>'Interpretation of the FEFF Calculation',
	     -foreground=>$config{colors}{activehighlightcolor},
	     -labelside=>'acrosstop')
      -> pack(-side=>'top', -anchor=>'c', -fill=>'x');
  $widgets{feff_intrp_header} = $widgets{feff_intrp_headerbox} ->
    Scrolled('ROText', -height=>5, -scrollbars=>'e',
	     -cursor => $mouse_over_cursor,)
      -> pack(-side=>'top', -anchor=>'c', -fill=>'x');
  $widgets{feff_intrp_header} -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  disable_mouse3($widgets{feff_intrp_header}->Subwidget("rotext"));
  $widgets{feff_intrp_header} -> bind('<ButtonPress-3>',\&intrp_header_menu);
  BindMouseWheel($widgets{feff_intrp_header});



  $widgets{feff_intrp} = $feffcard{Interpretation} ->
    Scrolled('HList',
	     -columns	       => 6,
	     -header	       => 1,
	     -scrollbars       => 'osoe',
	     -selectmode       => 'extended',
	     -selectbackground => $config{colors}{selected},
	     -font	       => $config{fonts}{fixed},
	     -command	       =>
	     sub{
	       my $which   = $widgets{feff_intrp}->selectionGet();
	       my $this;
	       my $nnnn    = sprintf("feff%4.4d.dat", $widgets{feff_intrp}->itemCget($which, 0, '-text'));
	       foreach my $k (sort (keys %paths)) {
		 next unless (ref($paths{$k}) =~ /Ifeffit/);
		 next unless ($paths{$k}->type eq 'path');
		 next unless ($paths{$k}->get('parent') eq $current);
		 $this = $paths{$k}->get('id'), last
		   if ($paths{$k}->get('feff') eq $nnnn);
	       };
	       ($list->selectionIncludes($this)) ?
		 $list->selectionClear($this) : $list->selectionSet($this);
	     })
      -> pack(-side=>'top', -expand=>1, -fill=>'both', -padx=>3, -pady=>3);

  $widgets{feff_intrp} -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $widgets{feff_intrp} -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $widgets{feff_intrp} -> bind('<ButtonPress-3>',\&snarf_path);


  $intrp_styles{header} = $widgets{feff_intrp} ->
    ItemStyle('text', -font=>$config{fonts}{smbold}, -anchor=>'w',
	      -foreground=>$config{colors}{foreground});
  foreach my $s (qw(normal ss focus)) {
    my $color = ($s eq 'normal') ? $config{colors}{background} : $config{intrp}{$s};
    my @list = ('text',
		-font		  => $config{fonts}{fixed},
		-background	  => $color,
		#-cursor		  => $mouse_over_cursor,
		-selectbackground => $color,
		-activebackground => $color);
    ## styles for included paths
    $intrp_styles{$s}           = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'center', -foreground => $config{colors}{foreground});
    $intrp_styles{$s."_amp"}    = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'e', -foreground => $config{colors}{foreground});
    $intrp_styles{$s."_path"}   = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'w', -foreground => $config{colors}{foreground});

    ## styles for excluded paths
    $intrp_styles{$s."_x"}      = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'center', -foreground => $config{intrp}{excluded}, -selectforeground => $config{intrp}{excluded});
    $intrp_styles{$s."_amp_x"}  = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'e', -foreground => $config{intrp}{excluded}, -selectforeground => $config{intrp}{excluded});
    $intrp_styles{$s."_path_x"} = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'w', -foreground => $config{intrp}{excluded}, -selectforeground => $config{intrp}{excluded});

    ## styles for absent paths
    $intrp_styles{$s."_a"}      = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'center', -foreground => $config{intrp}{absent}, -font => $config{intrp}{unimported}, -selectforeground => $config{intrp}{absent});
    $intrp_styles{$s."_amp_a"}  = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'e', -foreground => $config{intrp}{absent}, -font => $config{intrp}{unimported}, -selectforeground => $config{intrp}{absent});
    $intrp_styles{$s."_path_a"} = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'w', -foreground => $config{intrp}{absent}, -font => $config{intrp}{unimported}, -selectforeground => $config{intrp}{absent});

    ## styles for unimported paths
    $intrp_styles{$s."_u"}      = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'center', -foreground => $config{colors}{foreground}, -font => $config{intrp}{unimported});
    $intrp_styles{$s."_amp_u"}  = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'e', -foreground => $config{colors}{foreground}, -font => $config{intrp}{unimported});
    $intrp_styles{$s."_path_u"} = $widgets{feff_intrp} ->
      ItemStyle(@list,  -anchor => 'w', -foreground => $config{colors}{foreground}, -font => $config{intrp}{unimported});

  };


  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(0,
							     -text=>"#",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});
  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(1,
							     -text=>"Deg.",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});
  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(2,
							     -text=>"Reff",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});
  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(3,
							     -text=>"amp.",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});
  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(4,
							     -text=>"fs",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});
  $widgets{feff_intrp} -> Subwidget("hlist") -> headerCreate(5,
							     -text=>"Scattering Path",
							     -style=>$gds_styles{header},
							     -headerbackground=>$config{colors}{background});


  BindMouseWheel($widgets{feff_intrp});

  $widgets{help_intrp} =
    $feffcard{Interpretation}
      -> Button(-text=>'Document: Feff interpretation',  @button2_list,
		-command=>sub{pod_display("artemis_intrp.pod")} )
	-> pack(-side=>'bottom', -fill=>'x', -pady=>2);

  return $c;
};


sub set_feff_showing {
  return unless defined($widgets{feff_inptext}->Subwidget("yscrollbar"));
  $paths{$current}->make(feff_showing=>$_[0],
			 feff_inp_location=>
			 ($widgets{feff_inptext}->Subwidget("yscrollbar")->get())[0],
			 feff_intrp_location=>
			 ($widgets{feff_intrp}  ->Subwidget("yscrollbar")->get())[0]
			);
};



sub intrp_header_menu {
  my $w = shift;
  my $Ev = $w->XEvent;
  my ($X, $Y) = ($Ev->X, $Ev->Y);
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[
		      [ command => "View log of feff run",
			-command => [\&display_file, 'feff', 'feff.run']],
		      [ command => "View misc.dat",
			-command => [\&display_file, 'feff', 'misc.dat']],
		      [ command => "View files.dat",
			-command => [\&display_file, 'feff', 'files.dat']],
		      [ command => "View paths.dat",
			-command => [\&display_file, 'feff', 'paths.dat']],
		     ])
      -> Post($X, $Y);
  $w -> break;
  return;
};



sub snarf_path {

  ## 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
  my @sel = $w->selectionGet();
  $w->anchorSet($entry);
  my $clicked = $w->info('anchor');
  if (grep {/^$clicked$/} @sel) {
    ## right click within the current extended selection
    1;
  } else {
    ## right clicked outside the current extended selection
    $w->selectionClear;
    $w->selectionSet($entry);
    @sel = $w->selectionGet();
  };

  ## post the message with path-appropriate text
  my $which   = $w->infoAnchor;
  my $nnnn    = sprintf("feff%4.4d.dat", $w->itemCget($which, 0, '-text'));
  my ($X, $Y) = ($Ev->X, $Ev->Y);

  my $file = File::Spec->catfile($paths{$current}->get('path'), $nnnn);
  my $lab = "";
  my ($this, @these) = ("", ());
  ## the use of sort here is crufty, but it should mean that the first
  ## example of a path in the list which uses the feffNNNN.dat file
  ## indicated by $nnnn will be first

  ## These next two blocks map the anchor and the selection on the
  ## intrp to the corresponding paths in DPL.
  foreach my $k (sort (keys %paths)) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'path');
    next unless ($paths{$k}->get('parent') eq $current);
    ($lab,$this) = ($paths{$k}->get('lab'), $paths{$k}->get('id')), last
      if ($paths{$k}->get('feff') eq $nnnn);
  };
  my $anchor = $lab;
  if ($#sel>0) {
    $lab = "these paths";
    my $ii = 0;
    foreach my $s (@sel) {
      my $nnnn    = sprintf("feff%4.4d.dat", $w->itemCget($s, 0, '-text'));
    INNER: foreach my $k (sort (keys %paths)) {
	next unless (ref($paths{$k}) =~ /Ifeffit/);
	next unless ($paths{$k}->type eq 'path');
	next unless ($paths{$k}->get('parent') eq $current);
	push(@these, $paths{$k}->get('id')), last INNER
	  if ($paths{$k}->get('feff') eq $nnnn);
      };
      $these[$ii] ||= 0;
      ++$ii;
    };
  } else {
    ## if the selection and the anchor are the same, put the anchor
    ## and it's path in these arrays
    $lab = "\"" . $lab . "\"";
    @these = ($this);
    @sel = ($which);
  };

  ## some menu items are greyed out for multiple selection, some are
  ## greyed out for excluded paths
  if ($this) {
    $top ->
      Menu(-tearoff=>0,
	   -menuitems=>[['cascade' => "Plot data and $lab in ...",
			 -state=>($paths{$this}->get('include')) ? 'normal' : 'disabled',
			 -tearoff  => 0,
			 -menuitems=> [[ command => 'k',
				        -command => sub{&plot_path(\@these, 'k')}],
				       [ command => 'R',
				        -command => sub{&plot_path(\@these, 'R')}],
				       [ command => 'q',
				        -command => sub{&plot_path(\@these, 'q')}]]],
			['command' => "Jump to \"$anchor\"",
			 #-state => ($#sel>0) ? 'disabled' : 'normal',
			 -command  => sub{display_page($this)}],
			['command' =>
			 ($paths{$this}->get('include')) ? "Exclude $lab" : "Include $lab",
			 -command  => sub{
			   my $onoff = $paths{$this}->get('include');
			   foreach my $p (0..$#these) {
			     next unless exists $paths{$these[$p]};
			     if ($onoff) {
			       &select_paths('off', $these[$p], 1);
			     } else {
			       &select_paths('on',  $these[$p], 1);
			     };
			   };
			   &display_properties;
			   map {$widgets{feff_intrp}->selectionSet($_)} @sel;
			 }],
			['command' =>
			 (grep {$_ eq $this} $list->info('selection')) ? "Deselect $lab" : "Select $lab",
			 -state=>($paths{$this}->get('include')) ? 'normal' : 'disabled',
			 -command  => sub{my $how = (grep {$_ eq $this} $list->info('selection')) ? 1 : 0;
					  &path_select($how)}],
			['command' => "Plot $lab after fit",
			 -command  => sub{
			   foreach my $p (keys %paths) {
			     next unless ($paths{$p}->type eq 'path');
			     set_plotpath($p, 0);
			   };
			   foreach my $p (0..$#these) {
			     next unless (exists $paths{$these[$p]});
			     set_plotpath($these[$p], 1);
			   };
			 }],
			['command' => "Mark \"$anchor\" as current",
			 #-state => (($#sel>0) or not $paths{$this}->get('include')) ? 'disabled' : 'normal',
			 -command  => sub{&set_path_index($this)}],
			"-",
			['cascade' => "Edit path parameters",
			 -tearoff  => 0,
			 -menuitems=> [[ command => 'label',
				        -command => sub{&add_mathexp('label')}],
				       [ command => 'S02',
				        -command => sub{&add_mathexp('S02')}],
				       [ command => 'delE0',
				        -command => sub{&add_mathexp('E0')}],
				       [ command => 'delR',
				        -command => sub{&add_mathexp('delR')}],
				       [ command => 'sigma^2',
				        -command => sub{&add_mathexp('sigma^2')}],
				       [ command => 'Ei',
				        -command => sub{&add_mathexp('Ei')}],
				       [ command => '3rd',
				        -command => sub{&add_mathexp('3rd')}],
				       [ command => '4th',
				        -command => sub{&add_mathexp('4th')}],
					]],
			"-",
			[ command => "Show geometry for \"$anchor\"",
			 -command => [\&display_path_header, $this]],
			[ command => "View \"$anchor\"",
			 #-state => ($#sel>0) ? 'disabled' : 'normal',
			 -command => [\&display_file, 'path', $nnnn]],
			"-",
			['command' => "Discard $lab",
			 -command  => sub{
			   foreach my $p (0..$#these) {
			     next unless exists $paths{$these[$p]};
			     my $style = 'normal';
			     $style = "focus" if ($widgets{feff_intrp} -> itemCget($sel[$p],4,'-text') =~ /\d/);
			     $style = "ss"    if ($paths{$these[$p]} -> get('nleg') == 2);
			     &delete_path($these[$p]);
			   };
			   &display_properties;
			   map {$widgets{feff_intrp}->selectionSet($_)} @sel;
			 }],
		       ])
	-> Post($X,$Y);
  } elsif (-e $file) {
    my $text = ($#sel>0) ? "these paths" : $nnnn;
    $top ->
      Menu(-tearoff=>0,
	   -menuitems=>[[ command => "Add $text to the path list",
			 -command => sub {
			   foreach my $w (0..$#sel) {
			     next if ((exists $these[$w]) and (exists $paths{$these[$w]}));
			     my $nnnn    = sprintf("feff%4.4d.dat", $widgets{feff_intrp}->itemCget($sel[$w], 0, '-text'));
			     my $file = File::Spec->catfile($paths{$current}->get('path'), $nnnn);
			     add_a_path($file, 1, 0);
			   };
			   &display_properties;
			   map {$widgets{feff_intrp}->selectionSet($_)} @sel;
			 }],
			[ command => "Add and jump to $nnnn",
			 -state   => ($#sel>0) ? 'disabled' : 'normal',
			 -command => sub {
			   foreach my $w (0..$#sel) {
			     next if ((exists $these[$w]) and (exists $paths{$these[$w]}));
			     my $nnnn    = sprintf("feff%4.4d.dat", $widgets{feff_intrp}->itemCget($sel[$w], 0, '-text'));
			     my $file = File::Spec->catfile($paths{$current}->get('path'), $nnnn);
			     add_a_path($file, 0, 0);
			   };
			 }],
			(($config{histogram}{use}) ?
			 ("-",
			  [ command => "Make histogram using $nnnn",
			   -state   => ($#sel>0) ? 'disabled' : 'normal',
			   -command => [\&histogram, $lab]]) : ()),
			"-",
			[ command => "Show geometry for $anchor",
			 -command => sub {
			   $paths{toss} = Ifeffit::Path -> new(id     => "toss",
							       lab    => $nnnn,
							       type   => 'path',
							       feff   => $nnnn,
							       parent => $current,
							       path   => $paths{$current}->{path},
							       data   => $paths{$current}->{data},
							       family => \%paths);
			   my $header = nnnn_header("toss", File::Spec->catfile($paths{$current}->get('path'),
								   $nnnn));
			   $paths{toss} -> make(header => $header);
			   display_path_header("toss");
			   delete $paths{toss};
			 }],
			[ command => "View $anchor",
			 #-state => ($#sel>0) ? 'disabled' : 'normal',
			 -command => [\&display_file, 'path', $nnnn]],
		       ])
	-> Post($X, $Y);
  } else {
    $top ->
      Menu(-tearoff=>0, -disabledforeground => 'black',
	   -menuitems=>[[ command => "The file $nnnn does not exist.",
			 -state   => 'disabled',
			],
			[ command => "Perhaps you should rerun Feff.",
			 -state   => 'disabled',
			]])
	-> Post($X, $Y);
  };
};


sub path_select {
  my $how = $_[0];
  my @which   = $widgets{feff_intrp}->selectionGet();
  my $this;
  foreach my $w (@which) {
    my $nnnn    = sprintf("feff%4.4d.dat", $widgets{feff_intrp}->itemCget($w, 0, '-text'));
    foreach my $k (sort (keys %paths)) {
      next unless (ref($paths{$k}) =~ /Ifeffit/);
      next unless ($paths{$k}->type eq 'path');
      next unless ($paths{$k}->get('parent') eq $current);
      $this = $paths{$k}->get('id'), last
	if ($paths{$k}->get('feff') eq $nnnn);
    };
    ($how) ? $list->selectionClear($this) : $list->selectionSet($this);
  };
};

sub populate_feff {
  my $this = $_[0];

  $fefftabs -> pageconfigure('Atoms',          -state=>'disabled');
  $fefftabs -> pageconfigure('feff.inp',       -state=>'disabled');
  $fefftabs -> pageconfigure('Interpretation', -state=>'disabled');

  ## there is atoms data associated with this feff calc
  if ($paths{$current}->{mode} & 1) {
    $fefftabs -> pageconfigure('Atoms', -state=>'normal');
    $atoms_params{edge} = ucfirst($paths{$current}->get('atoms_edge'));
    $atoms_params{core} = lc($paths{$current}->get('atoms_core'));
    $atoms_params{core} ||= "^^nothing^^";

##     foreach my $k (grep /^atoms_core/, keys(%widgets)) {
##       $widgets{$k} -> configure(-value => "");
##       my $n = (split(/_/, $k))[2];
##       $widgets{$k} -> configure(-value => $n);
##       next unless ($paths{$current}->get("atoms_elem_$n") and
## 		   ($paths{$current}->get("atoms_elem_$n") !~ /^\s*$/));
##       $widgets{$k} -> configure(-value => lc($paths{$current}->get("atoms_tag_$n"))  ||
## 				          lc($paths{$current}->get("atoms_elem_$n")) ||
## 			                  $n );
##     };

    ## populate the table of sites
    populate_atoms($current);
    $atoms_params{edge} = $paths{$current}->get("atoms_edge");

    ## transfer the atoms_* values to the atoms_* widgets
    foreach my $k (grep /^atoms_/, keys(%{$paths{$current}})) {
      next if ($k =~ /_(atoms|edge|occ|core|titles)/);
      $widgets{$k} -> configure(-validate=>'none');
      $widgets{$k} -> delete(0, 'end');
      $widgets{$k} -> configure(-validate=>'key'), next
	if (($k =~ /(a|b|c|alpha|beta|gamma)$/) and ($paths{$current}->get($k) =~ /^(\s*|0)$/));
      $widgets{$k} -> configure(-validate=>'key'), next
	if (($k =~ /(alpha|beta|gamma)$/)       and ($paths{$current}->get($k) =~ /^(\s*|90)$/));
      $widgets{$k} -> insert('end', $paths{$current}->get($k));
      $widgets{$k} -> configure(-validate=>'key');
    };
    $widgets{atoms_titles} -> delete('1.0', 'end');
    my $titles = $paths{$current}->get('atoms_titles');
    $titles =~ s/<NL>/\n/g;
    $titles ||= "";
    $widgets{atoms_titles} -> insert('end', $titles);
  };


  ## there is a feff.inp file associated with this feff calc.
  if ($paths{$current}->get('mode') & 2) {
    $fefftabs -> pageconfigure('feff.inp', -state=>'normal');
    $widgets{feff_inptext} -> delete('1.0', 'end');
    if (-e $paths{$current}->get('feff.inp')) {
      local $/ = undef;
      open FI, $paths{$current}->get('feff.inp');
      $widgets{feff_inptext} -> insert('1.0', <FI>, "feffinp");
      $widgets{feff_inptext} -> FindAndReplaceAll("-regexp", "-nocase", "\r", "") if not $is_windows;
      close FI;
    } else {
      $widgets{feff_inptext} -> insert('1.0', "No feff.inp file found for this Feff calculation.", "feffwarn");
    };
    $widgets{feff_inptext} -> yviewMoveto($paths{$current}->get('feff_inp_location')||0);
    $widgets{feff_inptext} -> ResetUndo;
  };

  ## feff has been run and the intrp box needs to be filled
  if ($paths{$current}->get('mode') & 4) {
    $fefftabs -> pageconfigure('Interpretation', -state=>'normal');
    intrp_fill($current);
  };

  if ($paths{$current}->get('feff_showing')) {
    $fefftabs -> raise($paths{$current}->get('feff_showing'));
  } elsif ($paths{$current}->get('mode') & 4) {
    $fefftabs -> raise('Interpretation');
  } elsif ($paths{$current}->get('mode') & 2) {
    $fefftabs -> raise('feff.inp');
  } else {
    $fefftabs -> raise('Atoms');
  };

};



sub intrp_fill {
  my $which = $_[0];
  $widgets{feff_intrp} -> delete('all');
  $widgets{feff_intrp_header} -> delete(qw(1.0 end));
  my $i = 1;
  foreach my $l (split(/\n/, $paths{$which}->get('intrp'))) {

    next if ($l =~ /^\#\s*$/);
    next if ($l =~ /^\#\s*---/);
    next if ($l =~ /^\#\s*degen/);
    ## this is a header line
    ($l =~ /^\#/) and do {
      $l =~ s{\r}{};
      $widgets{feff_intrp_header} -> insert('end', $l."\n");
      next;
    };

    $widgets{feff_intrp}->add($i);
    my @line = split(" ", $l);
    shift @line;

    ## determine if this line describes a path which is included,
    ## excluded, absent, or unimported
    my $nnnn = "feff" . $line[0] . ".dat";
    my $style = "_u";
    my $file = File::Spec->catfile($paths{$current}->get('path'), $nnnn);
    if (-e $file) {
      my $this;
      ## the use of sort here is crufty, but it should mean that the first
      ## example of a path in the list which uses the feffNNNN.dat file
      ## indicated by $nnnn will be first
      foreach my $k (sort (keys %paths)) {
	next unless (ref($paths{$k}) =~ /Ifeffit/);
	next unless ($paths{$k}->type eq 'path');
	next unless ($paths{$k}->get('parent') eq $current);
	if ($paths{$k}->get('feff') eq $nnnn) {
	  $style = ($paths{$k}->get('include')) ? "" : "_x";
	  last;
	};
      };
    } else {
      $style = "_a";
    };

  SWITCH: {			# the $style variable tells us how to
                                # do the font, this switch is about
                                # the background (SS|focused|neither)

      ## this is a SS path
      ($l =~ /^2/) and do {
	$widgets{feff_intrp} -> itemCreate($i, 0, -text=>sprintf("%-3d", shift @line),
					   -style=>$intrp_styles{"ss".$style});
	$widgets{feff_intrp} -> itemCreate($i, 1, -text=>shift @line,
					   -style=>$intrp_styles{"ss".$style});
	$widgets{feff_intrp} -> itemCreate($i, 2, -text=>shift @line,
					   -style=>$intrp_styles{"ss".$style});
	$widgets{feff_intrp} -> itemCreate($i, 3, -text=>shift @line,
					   -style=>$intrp_styles{"ss_amp".$style});
	$widgets{feff_intrp} -> itemCreate($i, 4, -text=>"",
					   -style=>$intrp_styles{"ss".$style});
	shift @line;
	$widgets{feff_intrp} -> itemCreate($i, 5, -text=>join(" ", @line),
					   -style=>$intrp_styles{"ss_path".$style});
	last SWITCH;
      };

      ## this is a focussed MS path
      ($l =~ /[1-9] :/) and do {
	$widgets{feff_intrp} -> itemCreate($i, 0, -text=>sprintf("%-3d", shift @line),
					   -style=>$intrp_styles{"focus".$style});
	$widgets{feff_intrp} -> itemCreate($i, 1, -text=>shift @line,
					   -style=>$intrp_styles{"focus".$style});
	$widgets{feff_intrp} -> itemCreate($i, 2, -text=>shift @line,
					   -style=>$intrp_styles{"focus".$style});
	$widgets{feff_intrp} -> itemCreate($i, 3, -text=>shift @line,
					   -style=>$intrp_styles{"focus_amp".$style});
	$widgets{feff_intrp} -> itemCreate($i, 4, -text=>shift @line,
					   -style=>$intrp_styles{"focus".$style});
	shift @line;
	$widgets{feff_intrp} -> itemCreate($i, 5, -text=>join(" ", @line),
					   -style=>$intrp_styles{"focus_path".$style});
	last SWITCH;
      };

      ## this is a line that could not be interpretted
      ($l =~ /^\s*Could/) and do {
	## this should never happen if feff is run within Artemis,
	## deal with a flawed imported calculation when the time comes
	last SWITCH;
      };

      ## this is a normal line
      do {
	$widgets{feff_intrp} -> itemCreate($i, 0, -text=>sprintf("%-3d", shift @line),
					   -style=>$intrp_styles{"normal".$style});
	$widgets{feff_intrp} -> itemCreate($i, 1, -text=>shift @line,
					   -style=>$intrp_styles{"normal".$style});
	$widgets{feff_intrp} -> itemCreate($i, 2, -text=>shift @line,
					   -style=>$intrp_styles{"normal".$style});
	$widgets{feff_intrp} -> itemCreate($i, 3, -text=>shift @line,
					   -style=>$intrp_styles{"normal_amp".$style});
	$widgets{feff_intrp} -> itemCreate($i, 4, -text=>"",
					   -style=>$intrp_styles{"normal".$style});
	shift @line;
	$widgets{feff_intrp} -> itemCreate($i, 5, -text=>join(" ", @line),
					   -style=>$intrp_styles{"normal_path".$style});
	last SWITCH;
      };
    };

    ++$i;
  };

};


sub feff_template {

  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Do you want to import an existing feff.inp file or start with a blank page?",
		   -title          => 'Artemis: Question...',
		   -buttons        => ['Import feff.inp', 'Blank page', 'Cancel'],
		   -default_button => 'Blank page',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $answer = $dialog->Show();
  if ($answer eq 'Cancel') {
    Echo("Canceled new Feff");
    return;
  } elsif ($answer eq 'Import feff.inp') {
    Echo("Importing Feff file");
    read_feff(0);
    return;
  } else {
    Echo("Making Feff template");
  };


  ## =============================== empty data structures
  my $cell = Xray::Xtal::Cell -> new();
  my $keywords = Xray::Atoms -> new();
  $keywords -> make(identity=>"the Feff template generator in Artemis $VERSION",
		    die=>0);

  ## =============================== make the template
  my $contents = "";
  my (@cluster, @neutral);
  my $atp = "template".$config{atoms}{feff_version};
  ($atp = 'template8_exafs') if ($config{atoms}{feff_version} eq '8');
  my ($default_name, $is_feff) =
    &parse_atp($atp, $cell, $keywords, \@cluster, \@neutral, \$contents);

  ## this is a new feff calc, so make an object and a space to
  ## display it
  my $data = $paths{$current}->data;
  ## assign an id to this feff calc
  my $id = $data . '.feff' . $n_feff;

  ## &initialize_project(0);
  ## make a project feff folder
  my $project_feff_dir = &initialize_feff($id);

  $paths{$id} = Ifeffit::Path -> new(id		 => $id,
				     type	 => 'feff',
				     path	 => File::Spec->catfile($project_folder, $id),
				     data	 => $data,
				     lab	 => 'FEFF'.$n_feff,
				     family	 => \%paths,
				     atoms_atoms => []
				    );
  initialize_atoms($id);
  $paths{$id} -> make(mode=>2);
  my @autoparams;
  $#autoparams = 6;
  (@autoparams = autoparams_define($id, $n_feff, 0, 0)) if $config{autoparams}{do_autoparams};
  $paths{$id} -> make(autoparams=>[@autoparams]);



  $list -> add($id, -text=>'FEFF'.$n_feff, -style=>$list_styles{noplot});
  $list -> setmode($id, 'close');
  $list -> setmode($paths{$data}->get('id'), 'close')
    if ($list -> getmode($paths{$data}->get('id')) eq 'none');

  &set_fit_button('fit');
  display_page($id);
  project_state(0);
  ++$n_feff;


  ## and save it top a file in the project space
  my $feff_file = File::Spec->catfile($project_folder, $id, "feff.inp");
  open  FEFFFILE, ">".$feff_file or die "could not open $feff_file for writing";
  print FEFFFILE $contents;
  close FEFFFILE;



  $widgets{feff_inptext} -> Load(File::Spec->catfile($project_folder, $id, "feff.inp"));
  $widgets{feff_inptext} -> tagAdd("feffinp", qw(1.0 end));
  $widgets{feff_inptext} -> ResetUndo;
  $fefftabs -> pageconfigure('feff.inp', -state=>'normal');
  $fefftabs -> raise('feff.inp');

  undef $cell;
  undef $keywords;

  Echo("Generated a template feff.inp for feff$config{atoms}{feff_version}");


};



# sub change_path {
#   my $parent = $current;
#   $parent = $paths{$current}->get('parent') if ($paths{$current}->type eq "path");
#   ## what about case of current = data or fit|diff|bkg|res???
#   #$parent = $paths{$current}->get('parent') if ($paths{$current}->type eq "path");
#
#   #my $start = $paths{$parent}->get('path') || $current_data_dir;
#   #(-d $start) or ($start = $current_data_dir);
#   my $dir = "";
#   if ($Tk::VERSION < 804) {
#     $dir = $top -> DirSelect(-width=>40, -dir=>$current_data_dir,
# 			     -title=> "Artemis: Select a directory",
# 			     -text => "Select the correct path to your FEFF calculation",
# 			    ) -> Show;
#   } else {
#     $dir = $top -> chooseDirectory;
#   };
#   return 0 unless $dir;
#   ($dir =~ /^\/\//) and ($dir = substr($dir, 1)); # single leading slash
#   ($dir =~ /\/$/) or ($dir .= '/'); # trailing slash
#   ($is_windows) and ($dir =~ s/\//\\/g); # windows-ify slashes
#
#   my $which = "";
#   if ($paths{$current}->type =~ /(bkg|data|diff|fit|res)/) {
#     my $d = $1;
#     foreach my $p (keys %paths) {
#       next unless (ref($paths{$p}) =~ /Ifeffit/);
#       next unless $paths{$p}->type;
#       next unless ($p =~ /feff\d$/);
#       next unless ($paths{$p}->data eq $d);
#       $paths{$p} -> make(path=>$dir);
#       $paths{$p} -> make(mode=>2) if (-e $paths{$p}->get('feff.inp'));
#       my $intrp_ok = &do_intrp($p);
#       $paths{$p} -> make(mode=>$paths{$p}->get('mode')+4) if $intrp_ok;
#       $which = $p;
#     };
#   } else {
#     $paths{$parent} -> make(path=>$dir);
#     $paths{$parent} -> make(mode=>2) if (-e $paths{$parent}->get('feff.inp'));
#     my $intrp_ok = &do_intrp($parent);
#     $paths{$parent} -> make(mode=>$paths{$parent}->get('mode')+4) if $intrp_ok;
#     $which = $parent;
#   };
#
#   ## fixy up the path headers
#   foreach my $p (keys %paths) {
#     next unless (ref($paths{$p}) =~ /Ifeffit/);
#     next unless $paths{$p}->type;
#     next unless ($paths{$p}->get('parent') eq $which);
#
#     my $fname = $paths{$p}->{feff};
#     if (-e File::Spec->catfile($paths{$which}->get('path'), $fname)) {
#       $paths{$p} -> make(feff=>$fname);
#     ## try it lower case
#     } elsif (-e File::Spec->catfile($paths{$which}->get('path'), lc($fname))) {
#       $paths{$p} -> make(feff=>lc($fname));
#     ## try it upper case
#     } elsif (-e File::Spec->catfile($paths{$which}->get('path'), uc($fname))) {
#       $paths{$p} -> make(feff=>uc($fname));
#     ## try it capitalized
#     } elsif (-e File::Spec->catfile($paths{$which}->get('path'), uc($fname))) {
#       $paths{$p} -> make(feff=>ucfirst($fname));
#     ## uh oh!
#     } else {
#       1;
#     };
#
#
#     my $file = File::Spec->catfile($paths{$which}->get('path'), $paths{$p}->get('feff'));
#     if (-e $file) {
#       $paths{$p} -> make(header=>nnnn_header($p, $file));
#     } else {
#       $paths{$p} -> make(header=>"", include=>0);
#       $list -> entryconfigure($p, -style => $list_styles{$paths{$p}->pathstate("disabled")});
#     };
#   };
#
#   $current_data_dir = $dir;
#   display_properties;
# };


sub do_intrp {
  my $id = $_[0];
  my $retval = 0;
  Echo("Doing intrp for " . $paths{$id}->get('lab') . " ...");
#  $widgets{feff_intrp} -> delete(qw(1.0 end));
  if ((-e $paths{$id}->get('feff.inp')) and (-e $paths{$id}->get('files.dat')) and
      (-e $paths{$id}->get('paths.dat'))) {
    $paths{$id}->make(intrp=>$paths{$id}->intrp($config{intrp}{betamax},
						$config{intrp}{core_token}));
    my $data = $paths{$id}->data;
    if (lc($paths{$data}->get('pcelem')) eq 'h') {
      $paths{$data}->make(pcelem=>$paths{$id}->get('central'),
			  pcedge=>$paths{$id}->get('edge'));
    };
    #intrp_fill($id);
    $retval = 1;
  } else {
    my @files = grep { ! -e $paths{$id}->get($_) } (qw(feff.inp files.dat paths.dat));
    my $string = reverse(join(", ", @files));
    $string =~ s/,/ro\/dna ,/;
    $string = reverse $string;
    ##Echo("Could not find " . $string);
    $paths{$id}->make(intrp=>" Could not find " . $string);
  };
  Echo("Doing intrp for " . $paths{$id}->get('lab') . " ... done!");
  return $retval;
};


sub fetch_nnnn {
  my ($parent, $pathto, $f, $data) = @_;
  my $file = File::Spec->catfile($pathto,$f);
  next unless (-e $file);
  my $was_mac = $paths{data0} ->
    fix_mac($file, $stash_dir, lc($config{general}{mac_eol}), $top);
  Echo("\"$file\" had Macintosh EOL characters and was skipped."), return if ($was_mac == -1);
  if ($was_mac) {
    Echo("\"$file\" had Macintosh EOL characters and was fixed.");
    $file = $was_mac;
  };

  ##my $parent = $list -> infoParent($id);
  my $id = $list -> addchild($parent);
  $paths{$id} = Ifeffit::Path -> new(id	      => $id,
				     type     => 'path',
				     # group	 => $id,
				     file     => $f,
				     include  => 1,
				     plotpath => 0,
				     parent   => $parent,
				     do_k     =>  1,
				     data     => $data||$paths{$current}->data,
				     family   => \%paths);
  $paths{$id} -> make(header=>nnnn_header($id, $file));
  foreach my $l (split(/\n/, $paths{$parent}->get('intrp'))) {
    my $ss = substr($f,4,4);
    $paths{$id} -> make(feff_index=>sprintf('%d', $ss));
    $paths{$id} -> make(intrpline=>substr($l, 2)), last
      if ($l =~ /^\d\s+$ss/);
  };
  $paths{$id} -> pathlabel($config{paths}{label});
  my @autoparams = @{$paths{$parent}->get('autoparams')};
  foreach my $p (qw(s02 e0 delr sigma^2 ei 3rd 4th)) {
    my $this = shift @autoparams;
    $paths{$id} -> make($p=>$this);
  };
  $file_menu -> menu -> entryconfigure($save_index+4, -state=>($Tk::VERSION > 804) ? 'normal' : 'disabled'); # all paths
  project_state(0);
  return $id;
};


## the chomp; chop; thing is an attempt to handle the strange
## situation of running artemis on unix and having run feff on
## windows.  in that case a ^M (\015, \r) character gets left at the
## end of each line after chomping.
sub nnnn_header {
  my ($id, $file) = @_;
  my $nnnn = sprintf("%d", substr($paths{$id}->get('feff'), 4, 4));
  my $parent = $paths{$id}->get('parent');
  my $header = '';
  if (-e $paths{$parent}->get('paths.dat')) {
    open F, $paths{$parent}->get('paths.dat');
  PATHSDAT: while (<F>) {
      next unless (/index, nleg, degeneracy, r/);
      next unless (/^\s+$nnnn\b/);
      chomp; chop if (/\r$/);
      my @words = split(" ", $_);
      $paths{$id} -> make(nleg  => $words[1]||1,
			  reff  => $words[7]||0,
			  deg   => defined($words[2]) ? int($words[2]) : 0,
			  zcwif => 0);
      $header = sprintf(" %s legs  Reff=%s  degeneracy=%d\n\n",
			$paths{$id}->get('nleg'),
			$paths{$id}->get('reff'),
			$paths{$id}->get('deg'),);
      my $continue = 1;
      my $ileg = 1;
      while ($continue) {
	my $line = <F>;
	last PATHSDAT unless $line;
	chomp $line; chop $line if (/\r$/);
	if ($line =~ /^\s*x/) {
	} elsif ($line =~ /index, nleg, degeneracy, r/) {
	  $continue = 0;
	} else {
	  my @parts = split("'", $line);
	  $parts[1] ||= " ";
	  $parts[2] ||= "0 0 0";
	  my $coords = sprintf("%9.5f %9.5f %9.5f %d ", split(" ", $parts[0]));
	  my @pp = split(" ", $parts[2]);
	  my $angles = ($pp[2] > 0) ?
	    sprintf("       rleg=%s  beta=%7.3f  eta=%7.3f\n", @pp) :
	      sprintf("       rleg=%s  beta=%7.3f\n", @pp[0,1]);
	  $header .= "leg $ileg: " . $coords . $parts[1] . "\n" . $angles;
	  my @words = split(" ", $line);
	  if ($words[3] eq 0) {
	    $paths{$id} -> make(element=>$1) if ($line =~ /'(.*)\s*'/);
	  };
	  ++$ileg;
	};
      };
      last PATHSDAT;
    };
  } else {
    $paths{$id} -> make(nleg=>0, reff=>0, deg=>0, element=>" ", zcwif=>0);
  };
  close F;
  ## the ZCWIF isn't in the header, so I have to go read files.dat
  ## each time through.  sigh....
  my $filesdat = $paths{$id}->get('files.dat');
  my $thisnnnn = basename($file);
  if (-r $filesdat) {
    open FILES, $filesdat;
    ## or die "could not open $filesdat for reading in nnnn_header\n";
    while (<FILES>) {
      next unless (/^\s*$thisnnnn/);
      my @line = split(" ", $_);
      $paths{$id} -> make(zcwif=>$line[2]||0);
      last;
    };
  };
  close FILES;
  my $zcwif = $paths{$id}->get('zcwif');
  $header =~ s/degeneracy/amp=$zcwif  degen/;
  return $header;
};



## delete the currently selected feff calc and select/anchor the previous
## what if I want to delete entire calc from a path canvas
sub delete_feff {
  my $this   = $_[0] || $current;
  my $force  = $_[1];
  my $delete = $_[2] || 1;		# 0=compactify folder
				# 1=delete folder
				# 2=keep folder, delete groups (restore previous fit)
  my $label = $paths{$this}->get('lab');
  Echo('\"$label\" is not a FEFF calculation.'), return unless ($this =~ /feff\d+$/);
  unless ($force) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "Are you sure you want to discard \"$label\" and all its paths?",
		     -title          => 'Artemis: Verifying...',
		     -buttons        => [qw/Discard Cancel/],
		     -default_button => 'Discard',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    Echo("Not discarding \"$label\""), return unless ($response eq 'Discard');
  };
  ## remove the autoparams if they still exist
  my @names = (); my @indeces = ();
  foreach my $a (@{$paths{$this}{autoparams}}) {
    my $i = 0;
    foreach my $p (@gds) {
      if (lc($a) eq lc($p->{name})) {
	push(@names,   $a);
	push(@indeces, $i);
	last;
      };
      ++$i;
    };
  };
  if (@names) {
    my $response = "";
    if ($force) {
      ## do not want to see this dialog when discarding entire project
      ## or data set
      $response = "Discard";
    } else {
      my @vars = grep {defined($_) and ($_ !~ m{^\s*$})} @names;
      if (@vars) {
	my $addendum = join(",  ", @vars);
	my $dialog =
	  $top -> Dialog(-bitmap         => 'questhead',
			 -text           => "Do you want to discard the variables $addendum",
			 -title          => 'Artemis: Verifying...',
			 -buttons        => [qw/Discard Keep/],
			 -default_button => 'Discard',
			 -font           => $config{fonts}{med},
			 -popover        => 'cursor');
	&posted_Dialog;
	$response = $dialog->Show();
      } else {
	$response = "Keep";
      };
    };
    if ($response eq 'Discard') {
      my $offset = 0;		# needed because the list gets
                                # shorter each time
      foreach my $i (@indeces) {
	splice(@gds, $i-$offset, 1);
	++$offset;
      };
      $gds_selected{type}    = "guess";
      $gds_selected{name}    = "";
      $gds_selected{mathexp} = "";
      $gds_selected{which}   = 0;
      repopulate_gds2();
      @names = grep {defined($_) and ($_ !~ m{^\s*$})} @names;
      Echo("Discarded variables " . join(",  ", @names)) if @names;
    } else {
      Echo("Not discarding variables");
    };
  };
  $this = ($this =~ /feff\d+$/) ? $this : $paths{$this}->get('parent');

  if ($delete==0) {
    my $project_feff_folder = File::Spec->catfile($project_folder, $this);
    rmtree($project_feff_folder) if (-d $project_feff_folder);
  } elsif ($delete==1) {
    ## compact this directory, but don't delete it.  it needs to stick
    ## around in case the use should want to revert the fitting model to
    ## a fit that used it.
    feff_compactify($this);
  };

  my $new = $paths{$this}->data;
  my $message = $paths{$this}->descriptor();
  $list->delete('offsprings',$this);
  $list->delete('entry',$this);
  foreach (keys %paths) {
    next unless (ref($paths{$_}) =~ /Ifeffit/);
    next unless ($paths{$_}->type eq 'path');
    next unless ($paths{$_}->get('parent') eq $this);
    #$paths{$_}->dispose($paths{$_}->blank_path, $dmode); # unset this path
    $paths{$_}->drop;
    delete $paths{$_};
  };
  delete $paths{$this};

  if ($this eq $current) {
    $current = $new;
    project_state(0);
    display_page($new);
  };
  Echo("Discarded $message");
};


sub identify_feff {
  my $this = ($paths{$current}->type eq 'feff') ? $current : $paths{$current}->get('parent');
  Echo("This Feff: $this    This project: $project_folder");
};

sub rename_feff {
  Error("There are no feff calculations."), return unless $n_feff;
  my $this = $current;
  ($this = $paths{$current}->get('parent')) if ($paths{$current}->type eq 'path');
  if ($paths{$current}->type =~ /(bkg|data|diff|fit|res)/) {
    my $data = $current;
    ($data = $paths{$current}->data) if ($paths{$current}->type =~ /(bkg|diff|fit|res)/);
    my $n = 0;
    while ($n <= $n_feff) {
      ($this = "feff$n"), last if (($paths{$data.".feff".$n}->get('lab')) and
				   ($paths{$data.".feff".$n}->data eq $data));
      ++$n;
    };
  };
  my $oldname = $paths{$this}->get('lab');
  my $newname = $_[0];
  unless ($_[0]) {
    $newname = $oldname;
    my $label = "New name for \"$oldname\": ";
    my $dialog = get_string($dmode, $label, \$newname, \@rename_buffer);
    $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
    Echo("Not renaming ". $oldname), return if ($oldname eq $newname);
    $newname =~ s{[\"\']}{}g;
    my $exists = 0;
    foreach my $f (&all_feff) {
      $exists = 1, last if ($newname eq $paths{$f}->get('lab'));
    };
    Error("There is already a Feff calculation named \"$newname\"!"), return if $exists;
  };
  push @rename_buffer, $newname;
  project_state(0);
  $paths{$this} -> make(lab=>$newname);
  $list -> itemConfigure($this, 0, -text=>$newname);
  Echo("Renamed \"$oldname\" to \"$newname\".");
};


sub all_feff {
  return (sort (grep /^data\d+\.feff\d+$/, (keys %paths) ));
};


sub run_feff {
  my $this = $_[0];
  my $how_many = $_[1];
  my $feff_folder = File::Spec->catfile($project_folder, $paths{$this}->get('id'), "");
  my $feff_file = File::Spec->catfile($project_folder, $paths{$this}->get('id'), "feff.inp");
  my $was = cwd();

  Echo("Preparing to run FEFF ...");
  ## save the feff.inp file
  #Echo("Saving feff.inp file");
  #$widgets{feff_inptext} -> Save($feff_file);

  ## autosave
  &save_project(0,1);

  ## clean up the previous feff calculation
  opendir F, $feff_folder;
  my @nnnn = grep(/feff\d{4}\.dat/i, readdir F);
  closedir F;
  my $rerun_feff = 0;
  if (@nnnn) {
    Echo("Deleting old feffNNNN.dat files");
    map {unlink File::Spec->catfile($feff_folder, $_)} @nnnn;
    $rerun_feff = 1;
  };

  ## make the project feff folder the current working directory
  chdir $feff_folder;

  ## run feff (need to capture stdout and send to messages buffer)
  ##   raise_palette('messages');
  Running("Running feff (this could take a few minutes, please be patient) ... ");
  ##$top -> Busy();
  #my $feff_messages = `feff6`; # $config{feff}{feff_executable};

  ###  run feff --- PLATFORM DEPENDENT CODE ---

  ###  ------------------------------------------------
  ###  ---- *NIX --------------------------------------
  ###  ------------------------------------------------
  $notes{messages} -> delete(qw(1.0 end));
  raise_palette('messages');
  $top->update;
  unless ($is_windows) { # avoid problems if feff->feff_executable isn't
    my $which = `which $config{feff}{feff_executable}`;
    chomp $which;
    unless (-x $which) {
      Echo("Uh oh!  That Feff calculation did not run successfully.");
      $notes{messages}->insert('end', Ifeffit::ParseFeff -> error_4, 'warning');
      $notes{messages}->insert('end', "\n\tCurrent, incorrect value of feff->feff_executable:\n\t\t$config{feff}{feff_executable}\n\n", 'warning');
      $notes{messages}->see('1.0');
      $update->raise;
      return;
    };
  };
  ## fork the feff process
  my $pid = open(WRITEME, "$config{feff}{feff_executable} |");
  $notes{messages} -> grab;
  $| = 1;			      # unbuffer its output
  while (<WRITEME>) {		      # and display it in the message buffer
    $notes{messages} -> insert('end', $_);
    $notes{messages} -> yviewMoveto(1);
    $top -> update;
  };
  close WRITEME;
  $notes{messages} -> grabRelease;
  ###  ------------------------------------------------

  ###  ------------------------------------------------
  ###  ---- WINDOWS ----
  ###  ------------------------------------------------
  ## the fork seems to work on Windows, bless those perl developer elves!
  ###  ------------------------------------------------

  ## make sure that the run log is there
  unless (-e File::Spec->catfile($project_folder, $paths{$this}->get('id'), "feff.run")) {
    open LOG, ">".File::Spec->catfile($project_folder, $paths{$this}->get('id'), "feff.run");
    print LOG $notes{messages} -> get('1.0', 'end');
    close LOG;
  };
  ##$top -> Unbusy();

  ## uh oh!  problems running feff
  my $fefferr = File::Spec->catfile($project_folder, $paths{$this}->get('id'), "feff.err");
  my $err = Ifeffit::ParseFeff -> recognize( $notes{messages}->get(qw(1.0 end)) );
  if (($err eq 9) or ($err eq 11)) { # atoms close together OR heap exceeded
    $top -> Unbusy();
    $notes{messages}->insert('end', "\n");
    $notes{messages}->insert('end', Ifeffit::ParseFeff -> describe($err), 'warning');
    $notes{messages}->see('end');
    $update->raise;
  } elsif ($err) {
    ##&display_file('file', $fefferr);
    $top -> Unbusy();
    Error("Uh oh!  That Feff calculation did not run successfully.");
    $notes{messages}->insert('end', "\n");
    $notes{messages}->insert('end', Ifeffit::ParseFeff -> describe($err), 'warning');
    $notes{messages}->see('end');
    $update->raise;
    return;
  } else {
    Echo("Running feff ... done!");
  };

  my @nnnnlist;
  opendir D, $feff_folder or die "cannot read directory $feff_folder\n";
  @nnnnlist = sort grep /feff\d{4}\.dat/i, readdir D;
  closedir D;
  unless (@nnnnlist) {
    Error("There are no feffNNNN.dat files!  Something has gone wrong with your Feff calculation!");
    if ($config{feff}{feff_executable} =~ /feff7/i) {
      $notes{messages}->insert('end', "\n");
      $notes{messages}->insert('end', Ifeffit::ParseFeff -> describe(12), 'warning');
      $notes{messages}->see('end');
      $update->raise;
    };
    $top -> Unbusy();
    return;
  };
  $#nnnnlist = -1;

  ## snarf the list of paths to import
  my $response = $how_many;
  unless ($how_many) {
    my $text = "How many feff paths do you want to import right now?";
    $text .= "  (You seem to have run feff once before ... the best choice is probably \"No paths\")"
      if $rerun_feff;
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => $text,
		     -title          => 'Artemis: Question...',
		     -buttons        => ['No paths',
					 'Just the first',
					 "The first $config{paths}{firstn}",
					 'All paths'],
		     -default_button => ($rerun_feff) ? 'No paths' : 'All paths',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    $response = $dialog->Show();
    Echo("Importing " . lc($response));
  };
  my $is_busy = grep (/Busy/, $top->bindtags);
  $is_busy or $top -> Busy();
  $paths{$this} -> make(path=>$feff_folder);

  ## do intrp
  my $intrp_ok = &do_intrp($this);
  if ($intrp_ok) {
    my $m = $paths{$this}->get('mode');
    ($m += 4) unless ($m & 4);
    $paths{$this}->make(mode=>$m);
  };

  ## set display and increment feff counter
  $file_menu -> menu -> entryconfigure($save_index+6, -state=>'normal');
  $file_menu -> menu -> entryconfigure($save_index+4, -state=>($Tk::VERSION > 804) ? 'normal' : 'disabled'); # all paths
  &set_fit_button('fit');
  display_page($this);
  project_state(0);
  $fefftabs->raise('Interpretation');

  unless ($response eq 'No paths') {
    ## fetch list of feffNNNN.dat files
    opendir D, $feff_folder or die "cannot read directory $feff_folder\n";
    @nnnnlist = sort grep /feff\d{4}\.dat/i, readdir D;
    closedir D;
    ($#nnnnlist = 0) if ($response eq 'Just the first');
    ($#nnnnlist = $config{paths}{firstn}-1) if (($response =~ /^The first/) and
						($#nnnnlist > $config{paths}{firstn}-1));

    ## fetch all the paths to import
    my $i = 0;
    foreach my $f (sort {lc($a) cmp lc($b)} (@nnnnlist)) {
      (!$i) or ($i % 10) or Echo("Reading the ${i}th feffNNNN.dat file");
      my $kid = fetch_nnnn($this, $feff_folder, $f);
      $list -> entryconfigure($kid, -style=>$list_styles{$paths{$kid}->pathstate("enabled")},
			      -text=>$paths{$kid}->get('lab'));
      ++$i;
    };
  };
  intrp_fill($this);

  if ($err eq 11) {
    Error("See the message buffer for a warning about that Feff calculation.");
  } else {
    Echo("All done running FEFF.");
  };
  ## return the cwd and unbusy
  chdir $was;
  $is_busy or $top -> Unbusy();
};


## cloning feff calculations:  link and copy

sub clone_feff {
  my $type = $_[0];
  return unless (ref($paths{$current}) =~ /Ifeffit/);
  return if ($paths{$current}->type eq 'gsd');
  my @calcs = grep { (ref($paths{$_}) =~ /Ifeffit/) and ($paths{$_}->type eq 'feff') } (&path_list);
  my $data  = $paths{$current}->data;
  my $clone = $calcs[0];

  ## select a feff calculation to clone
  my $db = $top -> DialogBox(-title          => "Clone a Feff calculation",
			     -buttons        => [qw(OK Cancel)],
			     -default_button => 'OK');
  $db -> add('Label',
	     -text	 => "Which Feff calculcation would you like",
	     -font	 => $config{fonts}{med},
	     -foreground => $config{colors}{activehighlightcolor},)
    -> pack();
  $db -> add('Label',
	     -text	 => "to $type and add to " . $paths{$data}->get('lab') . "?",
	     -font	 => $config{fonts}{med},
	     -foreground => $config{colors}{activehighlightcolor},)
    -> pack();
  foreach my $c (@calcs) {
    $db -> add('Radiobutton', -text=>$paths{$c}->descriptor(),
	       -value=>$c,
	       -variable=>\$clone)
      -> pack(-anchor=>'w');
  };
  &posted_Dialog;
  my $answer = $db -> Show;
  Echo("Not cloning Feff calculation"), return if ($answer eq 'Cancel');
  Echo("Cloning Feff calculation");

  ## assign an id to the clones feff calc and make its object
  my $id = $data . '.feff' . $n_feff;
  my $project_feff_dir = "";
  $paths{$id} = Ifeffit::Path -> new(id     => $id,
				     group  => $id,
				     type   => 'feff',
				     data   => $data,
				     lab    => 'FEFF'.$n_feff,
				     family => \%paths,
				     linkto => ($type eq 'copy') ? 0 : $clone,
				     atoms_atoms => []);
  ## clone the properties of the feff calc, including all the atoms_ properties
  foreach my $k (qw(intrp path include mode edge central lab
		    feff.inp feff.run atoms.inp paths.dat misc.dat file.dat)) {
    $paths{$id} -> make($k => $paths{$clone}->get($k));
  };
  foreach my $a (keys %{$paths{$clone}}) {
    next unless ($a =~ /^atoms_/);
    $paths{$id} -> make($a => $paths{$clone}->get($a));
  };
  my @autoparams;
  $#autoparams = 6;
  (@autoparams = autoparams_define($id, $n_feff, 1, 0)) if $config{autoparams}{do_autoparams};
  $paths{$id} -> make(autoparams=>[@autoparams]);

  ## a link uses the files from an existing feff calculation, a copy
  ## copies all files from the other feff calc
  if ($type eq 'copy') {
    $project_feff_dir = &initialize_feff($id);
    $paths{$id} -> make(path=>$project_feff_dir);
    opendir F, $paths{$clone}->get('path');
    my @list = grep { -f File::Spec->catfile($paths{$clone}->get('path'),$_) } readdir F;
    closedir F;
    map { copy(File::Spec->catfile($paths{$clone}->get('path'),$_),
	       $project_feff_dir) } @list;
  };

  ## put the clone in the paths list
  $list -> add($id, -text=>$paths{$id}->{lab}, -style=>$list_styles{noplot});
  $list -> setmode($id, 'close');
  $list -> setmode($paths{$data}->get('id'), 'close')
    if ($list -> getmode($paths{$data}->get('id')) eq 'none');

  ## clone each of the paths corresponding to this path
  foreach my $p (&path_list) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless ($paths{$p}->type eq 'path');
    next unless ($paths{$p}->get('parent') eq $clone);
    ## add the cloned path to the list and make its object
    my $kid = $list -> addchild($id);
    $paths{$kid} = Ifeffit::Path -> new(id	 => $kid,
					type	 => 'path',
					parent   => $id,
					plotpath => 0,
					do_k	 => 1,
					data	 => $data,
					family   => \%paths);
    foreach my $k (qw(3rd 4th amp_array deg delr dphase e0 edge ei
		      element feff header include intrpline
		      k_array lab label nleg phase_array reff s02
		      setpath sigma^2 zcwif)) {
      $paths{$kid} -> make($k => $paths{$p}->get($k));
    };
    $list -> entryconfigure($kid,
			    -style=>$list_styles{$paths{$kid}->pathstate},
			    -text=>$paths{$kid}->get('lab'));
  };

  ## display this newly linked feff calculation
  ++$n_feff;
  $file_menu -> menu -> entryconfigure($save_index+6, -state=>'normal');
  $file_menu -> menu -> entryconfigure($save_index+4, -state=>($Tk::VERSION > 804) ? 'normal' : 'disabled'); # all paths
  display_page($id);
  project_state(0);
};


sub hide_branch {
  my ($path, $action) = @_;
  ##print join(" ", $path, $action), $/;
  if ($action eq '<Activate>') { # mouse button release
    if ($list -> getmode($path) eq 'close') {
      ## deselect any paths that are in the branch being closed

      ## closing a feff branch
      if ($paths{$path}->type eq 'feff') {
	foreach my $p ($list->info('selection')) {
	  next unless (ref($paths{$p}) =~ /Ifeffit/);
	  next unless ($paths{$p}->type eq 'path');
	  next unless ($paths{$p}->get('parent') eq $path);
	  $list->selectionClear($p);
	};

      ## closing a data branch
      } elsif ($paths{$path}->type eq 'data') {
	foreach my $p ($list->info('selection')) {
	  my $pp = $p;
	  ($pp = $1 . "_" . ("fit", "res", "bkg")[$2]) if $p =~ /(data\d)\.(\d)/;
	  next unless (ref($paths{$pp}) =~ /Ifeffit/);
	  if ($paths{$pp}->type eq 'path') {
	    next unless ($paths{$pp}->data eq $path);
	    $list->selectionClear($p);
	  } elsif ($paths{$pp}->type =~ '(bkg|fit|res)') {
	    next unless ($paths{$pp}->get('sameas') eq $path);
	    $list->selectionClear($p);
	  };
	};
      };

      $list -> close($path);

    } elsif ($list -> getmode($path) eq 'open') {
      $list -> open($path);
    };
  };
};

sub feff_compactify {
  my $feff = $_[0] || $paths{$current}->feff;
  Echo($paths{$feff}->descriptor . " is not a feff calculation or path"), return
    unless ($paths{$feff}->type =~ /(feff|path)/);
  Echo("Compacting " . $paths{$feff}->descriptor . " ...");
  my $folder = File::Spec->catfile($project_folder, $feff);
  my @to_delete;
  opendir F, $folder;
  foreach my $file (readdir F) {
    next if ($file =~ /^\./);
    next if (lc($file) =~ /^(atoms\.inp|f(eff(\.(inp|run)|_run\.log)|iles\.dat)|misc\.dat|path(00\.dat|s\.dat))$/);
    next if &path_used($folder, $file);
    push @to_delete, $file;
  };
  foreach my $td (@to_delete) {
    unlink File::Spec->catfile($folder, $td);
  };
  my $n = $#to_delete+1;
  Echo("Compacting " . $paths{$feff}->descriptor . " ... (deleted $n files) done!");
};


##  END OF THE SECTION ON THE FEFF PAGE

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
## The Atoms interface


sub make_atoms {

  my $atoms = $_[0];

  $atoms_params{edge} = 'K';
  $atoms_params{elem} = 'H';
  my @help_button = (-foreground       => $config{colors}{activehighlightcolor},
		     -font	       => $config{fonts}{small},
		     -relief	       => 'flat',
		     -borderwidth      => 0,
		     -cursor	       => $mouse_over_cursor,
		     -activeforeground => $config{colors}{mbutton},
		    );

  my $fr = $atoms -> LabFrame(-label=>'Titles',
			      -foreground=>$config{colors}{activehighlightcolor},
			      -labelside=>'acrosstop')
    -> pack(-side=>'top', -fill=>'x');
  $widgets{atoms_titles} = $fr -> Scrolled("Text",
					   -scrollbars=>'e',
					   -height=>3)
    -> pack(-side=>'top', -expand=>1, -fill=>'x');
  $widgets{atoms_titles} -> Subwidget("yscrollbar")
    ->configure(-background=>$config{colors}{background},
		($is_windows) ? () : (-width=>8));
  &disable_mouse3($widgets{atoms_titles}->Subwidget("text"));


  my $main = $atoms -> Frame()
    -> pack(-side=>'top', -expand=>1, -fill=>'both');

  $fr = $main -> Frame()
    -> pack(-side=>'left', -anchor=>'n');

  ## space group
##   my $lfr = $fr -> LabFrame(-label=>'Space group',
## 			    -foreground=>$config{colors}{activehighlightcolor},
## 			    -labelside=>'acrosstop')
##     -> grid(-column=>0, -row=>0, -columnspan=>2, -padx=>2);
##   &labframe_help($lfr);
  $fr -> Button(@help_button,
		-text=>'Space group', -command=>[\&Echo, $click_help{'Space group'}])
    -> grid(-column=>0, -row=>0, -sticky=>'e', -padx=>2, -pady=>2);
  $widgets{atoms_space} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				       -validate=>'key',
				       -validatecommand=>[\&set_atoms_params, 'space'])
    -> grid(-column=>1, -row=>0, -padx=>2, -pady=>2);
##    -> pack(-padx=>4, -pady=>4);

  ## lattice constants
  $fr -> Button(@help_button, -text=>'A', -command=>[\&Echo, $click_help{'A'}])
    -> grid(-column=>0, -row=>1, -sticky=>'e', -padx=>2);
  $widgets{atoms_a} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				   -validate=>'key',
				   -validatecommand=>[\&set_atoms_params, 'a'])
    -> grid(-column=>1, -row=>1);
  $fr -> Button(@help_button, -text=>'B', -command=>[\&Echo, $click_help{'B'}])
    -> grid(-column=>0, -row=>2, -sticky=>'e', -padx=>2);
  $widgets{atoms_b} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				   -validate=>'key',
				   -validatecommand=>[\&set_atoms_params, 'b'])
    -> grid(-column=>1, -row=>2);
  $fr -> Button(@help_button, -text=>'C', -command=>[\&Echo, $click_help{'C'}])
    -> grid(-column=>0, -row=>3, -sticky=>'e', -padx=>2);
  $widgets{atoms_c} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				   -validate=>'key',
				   -validatecommand=>[\&set_atoms_params, 'c'])
    -> grid(-column=>1, -row=>3);

  ## lattice angles
  $fr -> Button(@help_button, -text=>'Alpha', -command=>[\&Echo, $click_help{'Alpha'}])
    -> grid(-column=>0, -row=>4, -sticky=>'e', -padx=>2);
  $widgets{atoms_alpha} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				       -validate=>'key',
				       -validatecommand=>[\&set_atoms_params, 'alpha'])
    -> grid(-column=>1, -row=>4);
  $fr -> Button(@help_button, -text=>'Beta', -command=>[\&Echo, $click_help{'Beta'}])
    -> grid(-column=>0, -row=>5, -sticky=>'e', -padx=>2);
  $widgets{atoms_beta} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				      -validate=>'key',
				      -validatecommand=>[\&set_atoms_params, 'beta'])
    -> grid(-column=>1, -row=>5);
  $fr -> Button(@help_button, -text=>'Gamma', -command=>[\&Echo, $click_help{'Gamma'}])
    -> grid(-column=>0, -row=>6, -sticky=>'e', -padx=>2);
  $widgets{atoms_gamma} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				       -validate=>'key',
				       -validatecommand=>[\&set_atoms_params, 'gamma'])
    -> grid(-column=>1, -row=>6);



  ## cluster size and edge
  $fr -> Button(@help_button,
		-text=>'Cluster size', -command=>[\&Echo, $click_help{'Cluster size'}])
    -> grid(-column=>0, -row=>7, -sticky=>'e', -padx=>2, -pady=>2);
  $widgets{atoms_rmax} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
				      -validate=>'key',
				      -validatecommand=>[\&set_atoms_params, 'rmax'])
    -> grid(-column=>1, -row=>7, -padx=>2);
  $fr -> Button(@help_button, -text=>'Edge', -command=>[\&Echo, $click_help{'Edge'}])
    -> grid(-column=>0, -row=>8, -sticky=>'e', -padx=>2, -pady=>2);
  $widgets{atoms_edge} = $fr -> Optionmenu(-options=>[qw/K L3 L2 L1 none/],
					   -textvariable=>\$atoms_params{edge},
					   -borderwidth=>1,
					   -command=>\&set_edge,
					  )
    -> grid(-column=>1, -row=>8, -sticky=>'w', -padx=>2);


  ## shift vector
  $fr -> Button(@help_button,
		-text=>'Shift vector', -command=>[\&Echo, $click_help{'Shift vector'}])
    -> grid(-column=>0, -row=>9, -sticky=>'e', -padx=>2);
  $widgets{atoms_shiftx} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
					-validate=>'key',
					-validatecommand=>[\&set_atoms_params, 'shiftx'])
    -> grid(-column=>1, -row=>9, -padx=>2);
  $widgets{atoms_shifty} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
					-validate=>'key',
					-validatecommand=>[\&set_atoms_params, 'shifty'])
    -> grid(-column=>1, -row=>10, -padx=>2);
  $widgets{atoms_shiftz} = $fr -> Entry(-width=>10, -font=>$config{fonts}{fixed},
					-validate=>'key',
					-validatecommand=>[\&set_atoms_params, 'shiftz'])
    -> grid(-column=>1, -row=>11, -padx=>2);



  ## scrolled hlist of atom sites
  my $atoms_list;
  $atoms_list = $main -> Scrolled("HList",
				  -columns    => 7,
				  -header     => 1,
				  -scrollbars => 'osoe',
				  -background => $config{colors}{background},
				  -font	      => $config{fonts}{fixed},
				  -selectmode => 'extended',
				  -selectbackground => $config{colors}{selected},
				  -browsecmd  => \&atoms_edit,
				  #-command    => sub{1;},
			       )
    -> pack(-side=>'right', -expand=>1, -fill=>'both');
  $widgets{atoms_list} = $atoms_list;

  $atoms_styles{header}   = $atoms_list -> ItemStyle('text',
						     -font=>$config{fonts}{small},
						     -anchor=>'center',
						     -foreground=>$config{colors}{activehighlightcolor});
  $atoms_styles{normal}   = $atoms_list -> ItemStyle('text',
						     -font=>$config{fonts}{fixed},
						     -foreground=>$config{colors}{foreground},
						     -selectforeground=>$config{colors}{foreground},
						     -background=>$config{colors}{background});
  $atoms_styles{centered} = $atoms_list -> ItemStyle('text',
						     -font=>$config{fonts}{fixed},
						     -anchor=>'center',
						     -foreground=>$config{colors}{foreground},
						     -selectforeground=>$config{colors}{foreground},
						     -background=>$config{colors}{background});

  $atoms_list -> Subwidget("hlist") -> headerCreate(0, -text=>"",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(1, -text=>"Core",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(2, -text=>"El",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(3, -text=>"X",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(4, -text=>"Y",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(5, -text=>"Z",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);
  $atoms_list -> Subwidget("hlist") -> headerCreate(6, -text=>"Tag",
						    -style=>$atoms_styles{header},
						    -headerbackground=>$config{colors}{background},);

  $atoms_list -> Subwidget("hlist") -> columnWidth(0, -char=>3);
  ##$atoms_list -> Subwidget("hlist") -> columnWidth(2, -char=>3);
  $atoms_list -> Subwidget("hlist") -> columnWidth(3, -char=>8);
  $atoms_list -> Subwidget("hlist") -> columnWidth(4, -char=>8);
  $atoms_list -> Subwidget("hlist") -> columnWidth(5, -char=>8);
  $atoms_list -> Subwidget("hlist") -> columnWidth(6, -char=>10);

  $atoms_styles{normal}   = $atoms_list -> ItemStyle('text',
						     -font=>$config{fonts}{fixed},
						     -foreground=>$config{colors}{foreground},
						     -selectforeground=>$config{colors}{foreground},
						     -background=>$config{colors}{background});
  $atoms_styles{centered} = $atoms_list -> ItemStyle('text',
						     -font=>$config{fonts}{fixed},
						     -anchor=>'center',
						     -foreground=>$config{colors}{foreground},
						     -selectforeground=>$config{colors}{foreground},
						     -background=>$config{colors}{background});


  $atoms_list->bind('<ButtonPress-3>',\&atoms_post_menu);
  BindMouseWheel($atoms_list);
  $atoms_list -> Subwidget("xscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));
  $atoms_list -> Subwidget("yscrollbar")
    -> configure(-background=>$config{colors}{background},
		 ($is_windows) ? () : (-width=>8));

  my $edit = $atoms -> LabFrame(-label=>'Edit selected site',
				-foreground=>$config{colors}{activehighlightcolor},
				-labelside=>'acrosstop' )
    -> pack(-side=>'top', -padx=>2);
  $fr = $edit -> Frame()
    -> pack(-side=>'top', -expand=>1, -fill=>'x', -padx=>2);

  #if ($config{atoms}{elem} eq 'menu') {
  #  my @elem_list;
  #  $widgets{atoms_elem} = $fr -> BrowseEntry(-label => "Element ",
#					      -disabledforeground => $config{colors}{foreground},
#					      -state => 'readonly',
#					      -font=>$config{fonts}{small},
#					      -foreground=>$config{colors}{activehighlightcolor},
#					      -width=>5,
#					      -variable => \$atoms_params{elem},
#					      ##-choices => \@elem_list,
#					      -browsecmd=>sub{1;},
#					     );
#    map { $widgets{atoms_elem}-> insert('end', get_symbol($_)) } (1..9);
#    $widgets{atoms_elem}  -> pack(-side=>'left');
#  } else {
  $fr -> Label(-text=>'Element:',
	       -font=>$config{fonts}{small},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
    $widgets{atoms_elem} = $fr -> Entry(-width=>5)
      -> pack(-side=>'left');
  #};

  $fr -> Frame(-width=>8)
    -> pack(-side=>'left');


  $fr -> Label(-text=>'Tag:',
	       -font=>$config{fonts}{small},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  $widgets{atoms_tag} = $fr -> Entry(-width=>10)
    -> pack(-side=>'left');
  $fr -> Frame()
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $fr -> Button(-text=>"Define", @button2_list, -width=>15,
		-command=>\&atoms_define)
    -> pack(-side=>'left', -anchor=>'e', -padx=>8);

  $fr = $edit -> Frame()
    -> pack(-side=>'top', -expand=>1, -fill=>'x', -pady=>2, -padx=>2);
  $fr -> Label(-text=>'X:',
	       -font=>$config{fonts}{small},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  $widgets{atoms_x} = $fr -> Entry(-width=>7)
    -> pack(-side=>'left');
  $fr -> Label(-text=>'Y:',
	       -font=>$config{fonts}{small},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  $widgets{atoms_y} = $fr -> Entry(-width=>7)
    -> pack(-side=>'left');
  $fr -> Label(-text=>'Z:',
	       -font=>$config{fonts}{small},
	       -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left');
  $widgets{atoms_z} = $fr -> Entry(-width=>7)
    -> pack(-side=>'left');
  $fr -> Frame()
    -> pack(-side=>'left', -expand=>1, -fill=>'x');


  $fr -> Button(-text=>"New", @button2_list, -width=>15,
		-command=>\&atoms_new_site)
    -> pack(-side=>'right', -anchor=>'e', -padx=>8);

  foreach (qw(elem x y z tag)) {
    $widgets{"atoms_".$_} -> bind("<KeyPress-Return>", \&atoms_define);
  };


  ## run and document buttons
  $fr = $atoms -> Frame()
    -> pack(-side=>'bottom', -fill=>'x');
  $widgets{help_runfeff} =
    $fr -> Button(-text=>"Document: Atoms",  @button2_list, -width=>1,
		     -command=>sub{pod_display("artemis_atoms.pod")} )
	-> pack(-side=>'right', -fill=>'x', -padx=>2, -pady=>2, -expand =>1);
  $fr -> Button(-text=>'Run Atoms', @button2_list, -width=>1,
		-command=>\&run_atoms)
    -> pack(-side=>'left', -fill=>'x', -padx=>2, -pady=>2, -expand =>1);
};


sub new_atoms {
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Do you want to import an existing atoms.inp file or start with a blank page?",
		   -title          => 'Artemis: Question...',
		   -buttons        => ['Import atoms.inp', 'Blank page', 'Cancel'],
		   -default_button => 'Blank page',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $answer = $dialog->Show();
 SWITCH: {
    ($answer eq 'Import atoms.inp') and do {
      Echo("Importing Atoms data");
      &import_atoms;
      return;
    };
    ($answer eq 'Blank page') and do {
      Echo("Opening blank Atoms page");
      last SWITCH;
    };
    ($answer eq 'Cancel') and do {
      Echo("Canceled new Atoms page");
      return;
    };
  };

  my $data = $paths{$current}->data;
  ## assign an id to this feff calc
  my $id = $data . '.feff' . $n_feff;

  ## &initialize_project(0);
  ## make a project feff folder
  my $project_feff_dir = &initialize_feff($id);

  $paths{$id} = Ifeffit::Path -> new(id	    => $id,
				     type	    => 'feff',
				     path	    => File::Spec->catfile($project_folder, $id),
				     data	    => $data,
				     lab	    => 'FEFF'.$n_feff,
				     family      => \%paths,
				     atoms_atoms => [],
				    );
  &clear_atoms;
  initialize_atoms($id);
  $paths{$id} -> make(mode=>1);
  my @autoparams;
  $#autoparams = 6;
  (@autoparams = autoparams_define($id, $n_feff, 0, 0)) if $config{autoparams}{do_autoparams};
  $paths{$id} -> make(autoparams=>[@autoparams]);

  $list -> add($id, -text=>'FEFF'.$n_feff, -style=>$list_styles{noplot});
  $list -> setmode($id, 'close');
  $list -> setmode($paths{$data}->get('id'), 'close')
    if ($list -> getmode($paths{$data}->get('id')) eq 'none');

  &set_fit_button('fit');
  display_page($id);
  project_state(0);
  ++$n_feff;
  Echo("Made new atoms page");


};


sub clear_atoms {
  my $feff = $paths{$current}->feff;
  return unless $feff;
  $widgets{atoms_list} -> delete('all');
  $paths{$feff} -> make(atoms_atoms=>[]);
  foreach (qw(elem x y z tag a b c alpha beta gamma shiftx shifty shiftz space rmax)) {
    $widgets{"atoms_".$_}->delete(0, 'end');
    $paths{$feff} -> make("atoms_".$_ => "");
  };
  $widgets{atoms_titles}->delete('1.0', 'end');
  $paths{$feff} -> make(atoms_titles=>"");
  $atoms_params{edge} = 'K';
  $paths{$feff} -> make(atoms_edge=>'K');
};


sub initialize_atoms {
  my $this = $_[0];
  foreach my $k (qw(a b c alpha beta gamma shiftx shifty shiftz)) {
    $paths{$this} -> make("atoms_$k"=>0);
  };
  $paths{$this} -> make(atoms_space  => "");
  $paths{$this} -> make(atoms_rmax   => 6);
  $paths{$this} -> make(atoms_titles => "");
  $paths{$this} -> make(atoms_edge   => "K");
  $atoms_params{natoms} = 0;
  $atoms_params{edge}   = "K";
};



sub import_atoms {

  my ($file, $just_parse, $this_feff) = @_;
  unless ($file and (-e $file)) {
    ##local $Tk::FBox::a;
    ##local $Tk::FBox::b;
    my $path = $current_data_dir || cwd;
    my $types = [['Atoms input files',    '*.inp'],
		 ['CIF files',            '*.cif'],
		 ['Atoms and CIF files', ['*.inp','*.cif']],
		 ['All files',            '*'],];
    $file ||= $top -> getOpenFile(-filetypes=>$types,
				  ##(not $is_windows) ?
				  ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				  -initialdir=>$path,
				  -title => "Artemis: Open an Atoms input file");
    return unless ($file);
  };
  ## take care that this is really an atoms.inp file
  Error("\"$file\" is not an Atoms input file"), return unless ((Ifeffit::Files->is_atoms($file)) or
								(Ifeffit::Files->is_cif($file)) );

  track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
  my $data = ($this_feff) ? (split(/\./, $this_feff))[0] : $paths{$current}->data;
  my ($nm, $pth, $sff) = fileparse($file,".inp",".INP",".Inp",".cif", ".CIF",".Cif");
  push_mru($file, 1, "atoms") unless ($just_parse);

  my $record_number = 0;
  #if ($STAR::Parser and ($sff =~ /cif/i)) {
  if ($STAR_Parser_exists and Ifeffit::Files->is_cif($file)) {
    my @data = STAR::Parser->parse($file);
    my $n = $#data+1;
    if ($#data) {
      my $db = $top->DialogBox(-title=>"Artemis: multi-record CIF file",
			       -buttons=>['OK', 'Cancel'],
			       -default_button=>'OK',);
      $db->add('Label', -text=>"$nm contains $n records.",
	       -foreground=>$config{colors}{activehighlightcolor},)
	-> pack();
      $db->add('Label', -text=>"Which do you want to import?",
	       -foreground=>$config{colors}{activehighlightcolor},)
	-> pack();
      my $i = 0;
      foreach my $d (@data) {
	$db->add('Radiobutton',
		 -text     => $d->get_item_data(-item=>"_chemical_name_systematic") || basename($file),
		 -value    => $i,
		 -variable => \$record_number, )
	-> pack(-anchor=>'w');
	++$i;
      };
      &posted_Dialog;
      my $response = $db->Show;
      Echo("CIF import canceled"), return if ($response eq 'Cancel');
    };
  };

  ## assign an id to this feff calc
  my $id = $this_feff || $data . '.feff' . $n_feff;

  Echo("Importing crystallography file ... ");
  ## &initialize_project(0);
  ## make a project feff folder
  unless ($just_parse) {
    $paths{$id} = Ifeffit::Path
      -> new(id=>$id, type=>'feff', mode=>0,
	     data=>$data, lab=>'FEFF'.$n_feff, family=>\%paths,
	    );
    $paths{$id} -> make(path=>File::Spec->catfile($project_folder, $id));
    $paths{$id} -> make(mode => $paths{$id}->get('mode')+1);
    my @autoparams;
    $#autoparams = 6;
    (@autoparams = autoparams_define($id, $n_feff, 0, 0)) if $config{autoparams}{do_autoparams};
    $paths{$id} -> make(autoparams=>[@autoparams]);
  };

  my $project_feff_dir = ($paths{$id}->get('linkto')) ? $paths{$id}->get('path') : &initialize_feff($id);


  my $project_atoms = ($STAR_Parser_exists and Ifeffit::Files->is_cif($file)) ?
    File::Spec->catfile($project_feff_dir, "$nm.cif") :
	File::Spec->catfile($project_feff_dir, "atoms.inp");
  copy($file, $project_atoms) unless ($file eq $project_atoms);
  initialize_atoms($id);

  ## =============================== parse the input file,
  my $keywords = Xray::Atoms -> new();
  $keywords -> make('identity'=>"Artemis $VERSION", die=>0, quiet=>1);
  if ($STAR_Parser_exists and ($sff =~ /cif/i)) {
    $keywords -> parse_input($project_atoms, 0, 'cif', $record_number);
  } else {
    $keywords -> parse_input($project_atoms, 0, 'inp');
  };
  ## any problems???

  $paths{$id} -> make(atoms_core=>"");
  foreach my $k (qw(a b c alpha beta gamma edge core rmax space)) {
    $paths{$id} -> make("atoms_$k"=>$keywords->{$k});
  };
  my ($i, $cr) = (0,0);
  @atoms = ();
  foreach my $s (@{$keywords->{'sites'}}) {
    $atoms[$i] = $s;
    ($cr ||= $i) if (lc($paths{$id}->get('atoms_core')) eq lc($$s[0]));
    ($cr   = $i) if (lc($paths{$id}->get('atoms_core')) eq lc($$s[4]));
    ++$i;
  };
  $paths{$id} -> make("atoms_atoms"=>[@atoms]);
  ##populate_atoms($id);

  $cr ||= 0;
  my $abs = $atoms[$cr]->[0];
  $paths{$id}->make(atoms_edge=>(get_Z($abs) > 57) ? "L3" : "K")
    unless (lc($paths{$id}->get('atoms_edge')) =~ /(k|l[123])/);
  my $titles = join("<NL>", @{$keywords->{'title'}});
  #foreach my $t (@{$keywords->{'title'}}) {
  #  $titles .= $t . "<NL>";
  #};
  $paths{$id} -> make(atoms_titles=>$titles);
  my @shiftvec = @{$keywords->{shift}};
  $paths{$id} -> make(atoms_shiftx=>$shiftvec[0], atoms_shifty=>$shiftvec[1], atoms_shiftz=>$shiftvec[2]);

  undef $keywords;

  unless ($just_parse) {
    $list -> add($id, -text=>'FEFF'.$n_feff, -style=>$list_styles{noplot});
    $list -> setmode($id, 'close');
    $list -> setmode($paths{$data}->get('id'), 'close')
      if ($list -> getmode($paths{$data}->get('id')) eq 'none');


    if ($pth and (-e File::Spec->catfile($pth, "feff.inp"))) {
      my $dialog =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => "There is a feff.inp in this folder.  Would you like to import it as well?",
		       -title          => 'Artemis: Question importing atoms.inp...',
		       -buttons        => ['Yes', 'No'],
		       -default_button => 'Yes',
		       -font           => $config{fonts}{med},
		       -popover        => 'cursor');
      &posted_Dialog;
      my $response = $dialog->Show();
      if ($response eq 'Yes') {
	my $project_feff = File::Spec->catfile($project_feff_dir, "feff.inp");
	copy(File::Spec->catfile($pth, "feff.inp"), $project_feff);
	$paths{$id} -> make(mode => $paths{$id}->get('mode')+2);
      };
    };

    &set_fit_button('fit');
    display_page($id);
    project_state(0);
    ++$n_feff;
    $fefftabs -> raise('Atoms');
  };
  Echo("Importing crystallography file ... done!");
  if (Ifeffit::Files->is_cif($file)) {
    run_atoms("atoms", File::Spec->catfile($project_feff_dir, "atoms.inp"));
    unlink File::Spec->catfile($project_feff_dir, "feff.inp");
    Echo("You imported a CIF file.  Don't forget to set the absorber!");
  };
};


sub populate_atoms {
  my $this = $_[0];

  $widgets{atoms_list}->delete('all');

  @atoms = @{ $paths{$current}->get("atoms_atoms") };
  my $row = 0;
  $atoms_params{core} = 0;
  foreach my $s (@atoms) {
    my $n = $row+1;
    $widgets{atoms_list} -> add($row);
    $widgets{atoms_list} -> itemCreate($row, 0, -text=>$n,
				       -style=>$atoms_styles{centered});
    $widgets{atoms_list} -> itemCreate($row, 1, -itemtype=>'window',
				       -widget=>$widgets{atoms_list}->Radiobutton(-variable	  => \$atoms_params{core},
										  -foreground	  => $config{colors}{foreground},
										  -activeforeground => $config{colors}{foreground},
										  -selectcolor	  => $config{colors}{check},
										  -value	  => $row,
										  -text		  => "",
										  -command	  => \&set_core));
    $widgets{atoms_list} -> itemCreate($row, 2, -text=>$s->[0],
				       -style=>$atoms_styles{normal});
    $widgets{atoms_list} -> itemCreate($row, 3, -text=>$s->[1],
				       -style=>$atoms_styles{normal});
    $widgets{atoms_list} -> itemCreate($row, 4, -text=>$s->[2],
				       -style=>$atoms_styles{normal});
    $widgets{atoms_list} -> itemCreate($row, 5, -text=>$s->[3],
				       -style=>$atoms_styles{normal});
    $widgets{atoms_list} -> itemCreate($row, 6, -text=>$s->[4],
				       -style=>$atoms_styles{normal});
    ($atoms_params{core} = $row) if (($s->[4] eq $paths{$current}->get("atoms_core")) or
				     ($s->[0] eq $paths{$current}->get("atoms_core")));
    ++$row;
  };
  $atoms_params{natoms} = $row;
  ## clear out the edit area
  foreach (qw(elem x y z tag)) {
    $widgets{"atoms_".$_}->delete(0, 'end');
  };
  $widgets{atoms_list} -> selectionClear;
  $widgets{atoms_list} -> anchorClear;
};


sub set_edge {
  $paths{$current} -> make(atoms_edge=>$atoms_params{edge});
};

sub set_atp_menu {
  my (%atp, @menu);
  foreach my $d ($Xray::Atoms::atp_dir, $setup->find('atoms', 'atp_personal')) {
    opendir A, $d;
    foreach (grep /(.+)\.atp$/, readdir A) {
      my $key = substr($_, 0, -4);
      ++$atp{$key};
    };
    closedir A;
  };
  my $menu = $feff_menu -> cget('-menu') -> entrycget('  Write special output', '-menu');
  foreach my $a (sort(keys(%atp))) {
    next if ($a =~ /(dafs|powder|template)/);
    $menu -> add('command', -label=>$a, @menu_args,
		 -command=>sub{&run_atoms($a)});
  };
  #my $menu = $feff_menu -> Menu(-menuitems=>\@menu);
  #$feff_menu -> menu -> entryconfigure(12, -menuitems=>\@menu, -state=>'normal');
};


sub set_atoms_params {

  my ($k, $entry, $prop) = (shift, shift, shift);

  if ($k =~ /^([abc]|rmax)/) {
    ($entry =~ /^\s*$/) and ($entry = 0);	     # error checking ...
    ($entry =~ /^\s*\.\s*$/) and ($entry = 0); # a sole .
    ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
    ($entry < 0) and return 0;
  } elsif (($k eq 'alpha') or ($k eq 'beta') or ($k eq 'gamma')) {
    ($entry =~ /^\s*$/) and ($entry = 0);	     # error checking ...
    ($entry =~ /^\s*\.\s*$/) and ($entry = 0); # a sole .
    ($entry =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) or return 0;
    ($entry < 0) and return 0;
    ($entry > 180) and return 0;
  } elsif ($k =~ /(elem|tag)_(\d+)/) {
    my $key = join("_", "atoms", "core", $2);
    $paths{$current} -> make("atoms_$k"=>$entry);
    $widgets{$key} -> configure(-value =>
				lc($paths{$current}->get("atoms_tag_$2"))  ||
				lc($paths{$current}->get("atoms_elem_$2")) ||
				$2 );

  } elsif ($k =~ /^shift/) {	# skip check to allow writing
                                # fractions, just check later
    1;
  };
  ## also skip the check on the space group symbol

  $paths{$current} -> make("atoms_$k"=>$entry);
  project_state(0);
  return 1;
};


sub atoms_edit {
  my $row = $widgets{atoms_list}->info('anchor');
  foreach (qw(elem x y z tag)) {
    $widgets{"atoms_".$_}->delete(0, 'end');
  };
  #if ($config{atoms}{elem} eq 'menu') {
  #  $atoms_params{elem} = $widgets{atoms_list} -> itemCget($row, 2, '-text');
  #} else {
  $widgets{atoms_elem} -> insert('end', $widgets{atoms_list} -> itemCget($row, 2, '-text') || "");
  #};
  $widgets{atoms_x}    -> insert('end', $widgets{atoms_list} -> itemCget($row, 3, '-text') || "");
  $widgets{atoms_y}    -> insert('end', $widgets{atoms_list} -> itemCget($row, 4, '-text') || "");
  $widgets{atoms_z}    -> insert('end', $widgets{atoms_list} -> itemCget($row, 5, '-text') || "");
  $widgets{atoms_tag}  -> insert('end', $widgets{atoms_list} -> itemCget($row, 6, '-text') || "");
  $widgets{atoms_x}    -> focus();
};

sub atoms_define {
  my $row;
  Error("You did not supply an element symbol."), return if (lc($widgets{atoms_elem}->get()) =~ /^\s*$/);
  unless (lc($widgets{atoms_elem}->get()) =~ /^$Ifeffit::Files::elem_regex$/) {
    Error($widgets{atoms_elem}->get() . " is not a valid element symbol.");
    $widgets{atoms_elem}->focus;
    $widgets{atoms_elem}->selectionRange(0, 'end');
    return;
  };
  ## this is true if redefining an old site, false if this is a new site
  my $redefine = $widgets{atoms_list}->info('anchor');
  if (defined $redefine and ($redefine ne "")) {
    $row = $redefine;
  } else {
    $row = $atoms_params{natoms};
    $widgets{atoms_list} -> add($row);
  };

  my $tag = $widgets{atoms_tag}->get();
  $tag =~ s/\s//g;
  $widgets{atoms_tag}->delete(qw(0 end));
  $widgets{atoms_tag}->insert('end', $tag);
  ## fill the data structure
  $atoms[$row] = [ucfirst(lc($widgets{atoms_elem}->get())),
		  $widgets{atoms_x}->get(),
		  $widgets{atoms_y}->get(),
		  $widgets{atoms_z}->get(),
		  $tag,
		  1
		 ];

  ## fill in the table
  $widgets{atoms_list} -> itemCreate($row, 1, -itemtype=>'window',
				     -widget=>$widgets{atoms_list}->Radiobutton(-variable	  => \$atoms_params{core},
										-foreground	  => $config{colors}{foreground},
										-activeforeground => $config{colors}{foreground},
										-selectcolor	  => $config{colors}{check},
										-value		  => $row,
										-text		  => "",
										-command	  => \&set_core));
  $widgets{atoms_list} -> itemCreate($row, 2, -text=>ucfirst(lc($widgets{atoms_elem}->get())),
				     -style=>$atoms_styles{normal});
  $widgets{atoms_list} -> itemCreate($row, 3, -text=>$widgets{atoms_x}->get()||0,
				     -style=>$atoms_styles{normal});
  $widgets{atoms_list} -> itemCreate($row, 4, -text=>$widgets{atoms_y}->get()||0,
				     -style=>$atoms_styles{normal});
  $widgets{atoms_list} -> itemCreate($row, 5, -text=>$widgets{atoms_z}->get()||0,
				     -style=>$atoms_styles{normal});
  $widgets{atoms_list} -> itemCreate($row, 6, -text=>$tag,
				     -style=>$atoms_styles{normal});
  unless (defined $redefine and ($redefine ne "")) {
    ++$atoms_params{natoms};
    $widgets{atoms_list} -> itemCreate($row, 0, -text=>$atoms_params{natoms},
				       -style=>$atoms_styles{centered});
  };
  $paths{$current}->make(atoms_atoms=>[@atoms]);
  project_state(0);
  $atoms_params{core} = 0 if ($atoms_params{natoms} == 1);
  my $n = $row+1;
  Echo("Defined " . ucfirst(lc($widgets{atoms_elem}->get())) . " at site " . $n);
};

## callback attached to the core radiobuttons
sub set_core {
  $paths{$current}->make(atoms_core=>$atoms[$atoms_params{core}]->[4]||$atoms[$atoms_params{core}]->[0]);
  project_state(0);
};

sub atoms_new_site {
  foreach (qw(elem x y z tag)) {
    $widgets{"atoms_".$_}->delete(0, 'end');
  };
  $widgets{atoms_list} -> selectionClear;
  $widgets{atoms_list} -> anchorClear;
  $widgets{atoms_elem} -> focus;
};


sub post_sgb {
  Error("Sorry!  The space group browser is currently broken.  It'll get fixed eventually.");
  return;
  if (ref($sgb) =~ /SGB/) {
    ($sgb->state() eq "normal") ? $sgb->raise : $sgb->deiconify;
    $top -> update;
    return;
  }
  my @feff = &all_feff;
  Error("Viewing the space group browser requires that at least one Feff calculation exist"),
    return unless @feff;
  my @sgb_args = (-sgbActive    => $config{colors}{activehighlightcolor},
		  -sgbGroup     => $config{colors}{mbutton},
		  -button       => $config{colors}{button},
		  -buttonActive => $config{colors}{activebutton},
		  -buttonLabel  => $config{colors}{warning_fg},
		  -buttonFont   => $config{fonts}{small},
		  -sgbFont      => $config{fonts}{med},
		 );
  $sgb = $top
    -> SGB(-SpaceWidget=>\$widgets{atoms_space});
  $sgb->configure(@sgb_args);
  $sgb->Show;
};

sub atoms_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
  my @which = $w->selectionGet();
  $w->anchorSet($entry);
  my $clicked = $w->info('anchor');
  if (grep {/^$clicked$/} @which) {
    ## right click within the current extended selection
    1;
  } else {
    ## right clicked outside the current extended selection
    $w->selectionClear;
    $w->selectionSet($entry);
    @which = $w->selectionGet();
  };
  &atoms_edit;

  ## post the message with parameter-appropriate text
  my ($name, $index, $type);
  my @sites = @{ $paths{$current}->get("atoms_atoms") };
  if ($#which > 0) {
    $index = $w->info('anchor');
    $name = "these atoms";
    $type = 'extended';
  } else {
    $index = $which[0];
    $name = ($sites[$index]->[4]) ? '"'.$sites[$index]->[4].'"' : '"'.$sites[$index]->[0].'"';
  };
  my $anchor = ($sites[$index]->[4]) ? '"'.$sites[$index]->[4].'"' : '"'.$sites[$index]->[0].'"';
  my ($X, $Y) = ($Ev->X, $Ev->Y);
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[
		      [ cascade=>"Move $anchor ...",
		       -tearoff=>0,
		       -menuitems=>[
				    [ command=>"before ...",
				      -command=>sub{atoms_move("before")}],
				    [ command=>"after ...",
				      -command=>sub{atoms_move("after")}],
				   ]],
		      [ command=>"Copy $anchor",
		       -command=>[\&atoms_copy, $index]],
		      [ command=>"Discard $name",
		       -command=>[\&atoms_delete, \@which]],
		     ])
	-> Post($X, $Y);
  $w -> break;
};


sub atoms_save_page {
  my $which = $_[0] || $current;
  ## store the sites
  $paths{$which} -> make(atoms_atoms=>[@atoms]);
  ## store the entry box parameters
  foreach my $k (qw(a b c alpha beta gamma rmax space)) {
    $paths{$which} -> make("atoms_$k" => $widgets{"atoms_$k"}->get());
  };
  ## store non-entry widgets
  $paths{$which} -> make(atoms_edge => $atoms_params{edge});
  $paths{$which} -> make(atoms_core => $atoms[$atoms_params{core}]->[4] || $atoms[$atoms_params{core}]->[0]);
  ## store the titles
  my $titles = $widgets{atoms_titles}->get('1.0', 'end');
  $titles =~ s/\n/<NL>/g;
  $paths{$which} -> make(atoms_titles=>$titles);
};


sub atoms_move {
  my $which = $_[0];
  my $where = "";
  my $whch = $widgets{atoms_list}->info('anchor');
  my $row   = (ref($whch) eq 'ARRAY') ? $$whch[0] : $whch;
  if (($which eq 'before') or ($which eq 'after')) {
    my $tomove = $atoms[$row]->[4] || $atoms[$row]->[0];
    my $label = "Move \"$tomove\" $which site number: ";
    my $dialog = get_string($dmode, $label, \$where);
    $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
    return unless ($where);
    Error("Specify a site index as the target when moving a site."), return unless ($where =~ /^\d+$/);
  } elsif ($which eq 'up') {
    return unless $row;
    $where = $row;
    $which = 'before';
    Echo("This site is at the top of the list."), return if ($where == 0);
  } elsif ($which eq 'down') {
    return unless $row;
    $where = $row + 1;
    $which = 'after';
    Echo("This site is at the bottom of the list."), return if ($where == $#atoms+1);
  };

  ## have the target, identify location in @atoms array
  my $target = $where-1;
  ($target = $#atoms) if ($target > $#atoms);
  ($target = 1)       if ($target < 1);

  --$target if ($row < $target);
  my $save = splice(@atoms, $row, 1);
  if ($which eq 'before') {
    @atoms = (@atoms[0..$target-1], $save, @atoms[$target..$#atoms]);
  } elsif ($which eq 'after')  {
    @atoms = (@atoms[0..$target], $save, @atoms[$target+1..$#atoms]);
    $target += 1;
  };
  $paths{$current}->make(atoms_atoms=>[@atoms]);
  project_state(0);
  populate_atoms();
  $widgets{atoms_list}->selectionClear;
  $widgets{atoms_list}->anchorSet($target);
  $widgets{atoms_list}->selectionSet($target);
  atoms_edit();
};

sub atoms_copy {
  my $which = $_[0];
  splice(@atoms, $which, 1, $atoms[$which], $atoms[$which]);
  $paths{$current}->make(atoms_atoms=>[@atoms]);
  populate_atoms($current);
  my $message = "Made a copy of ";
  $message .= $atoms[$which]->[4]||$atoms[$which]->[0];
  $message .= " and inserted it at site ";
  ++$which;
  $widgets{atoms_list} -> selectionSet($which);
  $widgets{atoms_list} -> anchorSet($which);
  &atoms_edit;
  project_state(0);
  ++$which;
  Echo($message.$which);
};

sub atoms_delete {
  my $which = $_[0];
  my $i = 0;
  foreach my $w (@$which) {
    my $ww = $w-$i;
    my $elem = $atoms[$ww]->[0];
    splice(@atoms, $ww, 1);
    $paths{$current}->make(atoms_atoms=>[@atoms]);
    populate_atoms($current);
    ++$w; ++$i;
    Echo("Discarded the $elem atom at site $w");
  };
  project_state(0);
  ($atoms_params{core}=0) if ($atoms_params{core} > $#atoms);
  $plotr_button -> focus();
};

sub run_atoms {

  my $atp  = $_[0];
  my $file = $_[1];
  #print "in run_atoms: $atp\n";
  Echo("Running atoms ... ");

  ## read titles and edge -- which is ok since the current must be
  ## showing, but also need to update them in case of clicking away
  ## and back before running
  atoms_new_site();
  $top->focus;
  atoms_save_page($current);
  Echo("Refreshed atoms parameters ...");

  ## autosave
  &save_project(0,1);

  ## are there lattice constants?
  my $is_ok = 0;
  foreach my $x (qw(a b c)) {
    my $val = $widgets{"atoms_$x"} -> get;
    ++$is_ok if (($val =~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) and ($val > 0));
  };
  Error("Atoms aborted! You did not specify any lattice constants."), return unless $is_ok;

  Error("Atoms aborted! You must select an absorber atom by clicking on its button in the \"Core\" column."),
    return if ((not $paths{$current}->get("atoms_core")) or
	       ($paths{$current}->get('atoms_core') eq '^^nothing^^') or
	       ($paths{$current}->get('atoms_core') =~ /^\s*$/));
  my $core_ok = "";
  $core_ok = $paths{$current}->get('atoms_core') || "";
  Error("Atoms aborted! You did not identify the atomic species of the site you selected as the absorber."),
    return if (($core_ok =~ /^\s*$/) or ($core_ok =~ /^\d+$/));


  $top -> Busy();
  ## fill the Cell object
  my $cell = Xray::Xtal::Cell -> new();
  $cell -> make( Space_group=>$paths{$current}->get('atoms_space') );
  my ($this_sg) = $cell -> attributes('Space_group');
  unless ($this_sg) {
    $top -> Unbusy();
    Error("Invalid space group.  Atoms aborted.");
    return;
  };
  foreach my $param (qw(a b c alpha beta gamma)) {
    next unless ($paths{$current}->get("atoms_$param") =~ /^\s*(\d+\.?\d*|\.\d+)\s*$/);
    $cell -> make( $param=>$paths{$current}->get("atoms_$param") );
  };
  ## fill the Site objects
  my (@sites, @ksites);
  my $nsites = 0;
  my $keywords = Xray::Atoms -> new(die=>1);
  my $tag_bad = 0;
  my $xtal_warnings = q{};
  ##foreach my $k (sort (grep /^atoms_elem_\d+$/, (keys %widgets))) {
  my $count = 0;
  foreach my $s (@{ $paths{$current}->get("atoms_atoms") }) {
    check_for_third($s, $count);
    ++$count;
  };
  atoms_save_page($current);
  foreach my $s (@{ $paths{$current}->get("atoms_atoms") }) {
    $sites[$nsites] = Xray::Xtal::Site -> new($nsites);
    ## this mess allows for simple fractions and such
    $sites[$nsites] -> make(Element=>$s->[0],
			    X=>Xray::Atoms::number($s->[1],  1) +
			       Xray::Atoms::number($paths{$current}->get('atoms_shiftx'),1),
			    Y=>Xray::Atoms::number($s->[2],  1) +
			       Xray::Atoms::number($paths{$current}->get('atoms_shifty'),1),
			    Z=>Xray::Atoms::number($s->[3],  1) +
			       Xray::Atoms::number($paths{$current}->get('atoms_shiftz'),1), );
    if ($s->[4]) {
      $sites[$nsites] -> make(Tag=>$s->[4]);
      $tag_bad = 1 if ($s->[4] =~ /^\d+$/);
    };
    ($s->[5]) && ( $sites[$nsites] -> make(Occupancy=>$s->[5]) );
    $xtal_warnings .= $sites[$nsites] -> {message_buffer};
    $sites[$nsites] -> reset_message_buffer;
    ++$nsites;
    push @{$keywords->{sites}}, $s;
  };
  if ($tag_bad) {
    $top -> Unbusy;
    Error("Atoms aborted! A site tag cannot be an integer.");
    return;
  };
  my ($ed, $abs, $is_odd) = odd_edge_absorber($current);
  if ($is_odd) {
    my $message = "Measuring the $ed edge of $abs seems odd.  Is this correct?";

    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => $message,
		     -title          => 'Artemis: Question...',
		     -buttons        => ['Yes, continue', 'No, cancel'],
		     -default_button => 'No, cancel',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    my $answer = $dialog->Show();
    if ($answer eq 'No, cancel') {
      $top -> Unbusy;
      Echo("Aborting Atoms due to odd edge/absorber combination.");
      return;
    };
  };
  if ($xtal_warnings) {
    Error("There are possible problems reading the crystallographic data.");
    post_message($xtal_warnings, 'Error messages');
    $xtal_warnings = q{};
  };

  ## load all the values back into an Atoms keyword object
  $keywords -> make(identity => "Artemis $VERSION",
		    die      => 1,
		    quiet    => 1,
		    program  => 'Artemis',
		    edge     => $paths{$current}->get('atoms_edge'),
		    core     => $paths{$current}->get('atoms_core'),
		    space    => $paths{$current}->get('atoms_space'),
		    a	     => $paths{$current}->get('atoms_a'),
		    b	     => $paths{$current}->get('atoms_b'),
		    c	     => $paths{$current}->get('atoms_c'),
		    alpha    => $paths{$current}->get('atoms_alpha'),
		    beta     => $paths{$current}->get('atoms_beta'),
		    gamma    => $paths{$current}->get('atoms_gamma'),
		    rmax     => $paths{$current}->get('atoms_rmax'),
		    argon    => 0,
		    krypton  => 0,
		    nitrogen => 0,
		    );
  $keywords -> make(shift => $paths{$current}->get('atoms_shiftx'),
		             $paths{$current}->get('atoms_shifty'),
		             $paths{$current}->get('atoms_shiftz'),);
  map { $keywords -> make(title=>$_) } (split(/<NL>/, $paths{$current}->get('atoms_titles')));
  Echo("Read crystallographic parameters ...");

  ## =============================== error check, populate the cell, set rmax
  $cell -> verify_cell();
  $cell -> populate(\@sites);
  my $trouble = $keywords -> verify_keywords($cell, \@sites, 1);
  if ($trouble) {
    $top -> Unbusy();
    Error("Trouble found among the parameters.  Atoms aborted.");
    return;
  };

  my $message = "";
  $message .= $cell -> warn_shift();
  $message .= $cell -> cell_check();
  post_message($message, 'Atoms warnings') if $message;
  Echo("Processed crystallographic parameters ...");


  my (@cluster, @neutral);
  my ($atoms, $feff) = "";
  if ($atp) {
    build_cluster($cell, $keywords, \@cluster, \@neutral);
    my ($default_name, $is_feff) =
      &parse_atp($atp, $cell, $keywords, \@cluster, \@neutral, \$atoms);
    Echo("Made ATP output ($atp)");
    if ($file) {
      open A, ">".$file;
      print A $atoms;
      close A;
    } else {
      $notes{files} -> delete(qw(1.0 end));
      $notes{files} -> insert('end', $atoms);
      $notes{files} -> yviewMoveto(0);
      $current_file = $default_name;
      $top -> update;
      $generic_name = $default_name;
      raise_palette('files');
    };
  } else {
    my $echomsg = "Made ATP output (";
    build_cluster($cell, $keywords, \@cluster, \@neutral);
    my ($default_name, $is_feff) =
      &parse_atp('atoms', $cell, $keywords, \@cluster, \@neutral, \$atoms);
    $echomsg .= "atoms ";
    my $feffv = $config{atoms}{template};
    ## my $feffv = "feff";
    ## ($feffv = 'feff7') if ($config{atoms}{feff_version} == 7);
    ## ($feffv = 'feff8_exafs') if ($config{atoms}{feff_version} == 8);
    ($default_name, $is_feff) =
      &parse_atp($feffv, $cell, $keywords, \@cluster, \@neutral, \$feff);
    $echomsg .= "$feffv) ...";
    Echo($echomsg);
  };

  ## refill Path object and widgets with results from the atoms run
  my @lattice = $cell -> attributes("A", "B", "C", "Alpha", "Beta", "Gamma");
  $paths{$current}->make(atoms_a     => $lattice[0]);
  $paths{$current}->make(atoms_b     => $lattice[1]);
  $paths{$current}->make(atoms_c     => $lattice[2]);
  $paths{$current}->make(atoms_alpha => $lattice[3]);
  $paths{$current}->make(atoms_beta  => $lattice[4]);
  $paths{$current}->make(atoms_gamma => $lattice[5]);
  foreach my $p (qw(a b c alpha beta gamma)) {
    $widgets{"atoms_$p"} -> configure(-validate=>'none');
    $widgets{"atoms_$p"} -> delete(0, 'end');
    $widgets{"atoms_$p"} -> insert('end', $paths{$current}->get("atoms_$p"));
    $widgets{"atoms_$p"} -> configure(-validate=>'key');
  };

  ## skip this block if this is just some ol' atp output
  unless ($atp) {

    ## save the atoms.inp and feff.inp files
    my $id = $paths{$current}->get('id');
    my $atoms_file = File::Spec->catfile($project_folder, $id, "atoms.inp");
    open ATOMSFILE, ">".$atoms_file or die "could not open $atoms_file for writing";
    print ATOMSFILE $atoms;
    close ATOMSFILE;
    my $feff_file = File::Spec->catfile($project_folder, $id, "feff.inp");
    open FEFFFILE, ">".$feff_file or die "could not open $feff_file for writing";
    print FEFFFILE $feff;
    close FEFFFILE;

    ## send the feff.inp to its tab and display that tab
    #$widgets{feff_inptext} -> delete('1.0', 'end');
    #$widgets{feff_inptext} -> insert('1.0', $feff);
    $widgets{feff_inptext} -> Load(File::Spec->catfile($project_folder, $id, "feff.inp"));
    $widgets{feff_inptext} -> tagAdd("feffinp", qw(1.0 end));
    $widgets{feff_inptext} -> ResetUndo;
    $fefftabs -> pageconfigure('feff.inp', -state=>'normal');
    $fefftabs -> raise('feff.inp');

    $paths{$current} -> make(mode => $paths{$current}->get('mode')+2) unless
      ($paths{$current}->get('mode') & 2);
  };

  project_state(0);

  $top -> Unbusy();
  Echo("Running atoms ... done!");
}

## these cutoffs are a bit arbitrary
sub odd_edge_absorber {
  my $this = $_[0];
  my $edge = $paths{$this}->get('atoms_edge');
  my $tag  = $paths{$this}->get('atoms_core');
#  print "core=",$tag, $/;
  my $absorber = "";
  foreach my $s (@{ $paths{$current}->get("atoms_atoms") }) {
    my $this = lc($s->[4]) || lc($s->[0]);
    ($absorber = $s->[0]), last if (lc($tag) eq $this);
  };
  my $z = get_Z($absorber);
#  print "z=",$z, $/;
#  print "absorber=",$absorber, $/;

  my $is_odd = 0;
  ($is_odd = 1) if (($z > 59) and ($edge =~ /k/i)); # K edge above praseodymium
  ($is_odd = 1) if (($z < 45) and ($edge =~ /l/i)); # L edge below rhodium

  #print "$edge $absorber $z\n";
  return ($edge, $absorber, $is_odd);
};

sub check_for_third {
  my ($site, $row) = @_;
  my @col = (q{}, qw(x y z));
  foreach my $coord (1, 2, 3) {
    my $val = Xray::Atoms::number($site->[$coord], 1);	# watch out for fractions
    my $diff = abs($val - THIRD);
    my $id = $site->[4] || $site->[0];
    if ( ($diff < DELTA) and ($diff > EPSILON) ) {
      my $dialog =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => "The $col[$coord] coordinate of $id is very close to 1/3.  Atoms and Feff operate at 5 digits of precision.  Do you want to use the value $site->[$coord] or should Artemis change this value to 1/3?",
		       -title          => 'Artemis: Question...',
		       -buttons        => ["Use $site->[$coord]", 'Change to 1/3'],
		       -default_button => 'Change to 1/3',
		       -font           => $config{fonts}{med},);
      &posted_Dialog;
      #$dialog->Subwidget("message")->configure(-width=>100);
      my $answer = $dialog->Show();
      if ($answer eq "Change to 1/3") {
	$widgets{atoms_list} -> itemConfigure($row, $coord+2, -text=>"1/3");
	$atoms[$row]->[$coord] = 0.33333;
      };
    };
    $diff = abs($val - TWOTH);
    if ( ($diff < DELTA) and ($diff > EPSILON) ) {
      my $dialog =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => "The $coord coordinate of $id is very close to 2/3.  Atoms and Feff operate at 5 digits of precision.  Do you want to use the value $site->[$coord] or should Artemis change this value to 2/3?",
		       -title          => 'Artemis: Question...',
		       -buttons        => ["Use $site->[$coord]", 'Change to 2/3'],
		       -default_button => 'Change to 2/3',
		       -font           => $config{fonts}{med},);
      &posted_Dialog;
      my $answer = $dialog->Show();
      if ($answer eq "Change to 2/3") {
	$widgets{atoms_list} -> itemConfigure($row, $coord+2, -text=>"2/3");
	$atoms[$row]->[$coord] = 0.66667;
      };
    };
  };
};
# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
## THE PATH PAGE


sub make_path {
  my $parent = $_[0];
  my $x_bitmap = '#define noname_width 13
#define noname_height 13
static char noname_bits[] = {
 0x00,0x00,0x0c,0x1c,0x18,0x0e,0x30,0x07,0xe0,0x03,0xc0,0x01,0xe0,0x01,0x70,
 0x03,0x38,0x06,0x1c,0x0c,0x0c,0x18,0x00,0x00,0x00,0x00};
';
  my $x_X = $top -> Bitmap('x', -data=>$x_bitmap,
			   -foreground=>$config{colors}{activehighlightcolor});
  my @x=(-image=>$x_X);

  my $c = $parent -> Frame(-relief=>'flat',
			   -borderwidth=>0,
			   #@window_size,
			   -highlightcolor=>$config{colors}{background},
			  );

  my $t = "";			# used for clicky help
  my @start = (-foreground=>$config{colors}{activehighlightcolor},
	       -font=>$config{fonts}{med});
  my @bold   = (-foreground => $config{colors}{mbutton},
		-background => $config{colors}{activebackground},
		-cursor     => $mouse_over_cursor,
		-font       => $config{fonts}{med});
  my @normal = (-foreground => $config{colors}{activehighlightcolor},
		-background => $config{colors}{background},
		-font       => $config{fonts}{med});
  ## header
  ##$header{current} = $c -> Label(@title2, -text=>"Path Description",)
  ##  -> pack(-side=>'top', -anchor=>'w', -padx=>6);


  #my $fr = $c -> Frame()
  #  -> pack(-side=>'top', -anchor=>'w', -fill=>'x',  -padx=>6);
  $widgets{path_label} = $c -> Label(-font        => $config{fonts}{bold},
				     -foreground  => $config{colors}{button},
				     -background  => $config{colors}{background2},
				     -borderwidth => 2,
				     -relief      => 'groove',
				     -anchor      => 'w',
				     )
    -> pack(-side=>'top', -anchor=>'w', -pady=>0, -fill=>'x');

  my $fr = $c -> Frame()
    -> pack(-side=>'top', -anchor=>'e', -fill=>'x',  -padx=>6);
  $widgets{path_include} = $fr -> Checkbutton(-text		=> "Include in the fit",
					      -font		=> $config{fonts}{med},
					      -foreground	=> $config{colors}{activehighlightcolor},
					      -activeforeground	=> $config{colors}{activehighlightcolor},
					      -selectcolor	=> $config{colors}{check},
					      -command		=> \&toggle_include,
					     )
    -> pack(-side=>'right', -anchor=>'w');
  $widgets{path_plotpath} = $fr -> Checkbutton(-text		 => "Plot after the fit",
					       -font		 => $config{fonts}{med},
					       -foreground	 => $config{colors}{activehighlightcolor},
					       -activeforeground => $config{colors}{activehighlightcolor},
					       -selectcolor	 => $config{colors}{check},
					       -command		 => \&toggle_plotpath,
					      )
    -> pack(-side=>'left', -anchor=>'e');
  $fr = $c -> Frame()
    -> pack(-side=>'top', -anchor=>'e', -fill=>'x',  -padx=>6);
  $widgets{path_setpath} = $fr -> Checkbutton(-text		=> "Make this path the default after the fit",
					      -font		=> $config{fonts}{med},
					      -foreground	=> $config{colors}{activehighlightcolor},
					      -activeforeground	=> $config{colors}{activehighlightcolor},
					      -selectcolor	=> $config{colors}{check},
					      -command		=> sub{&set_path_index($current)},
					     )
    -> pack(-side=>'left', -anchor=>'e');

  $widgets{path_header_box} =
    $c-> LabFrame(-label      => '',
		  -font	      => $config{fonts}{med},
		  -foreground => $config{colors}{activehighlightcolor},
		  -labelside  => 'acrosstop')
      -> pack(-side=>'top', -pady=>3, -padx=>6, -fill=>'x');
  $widgets{path_header} = $widgets{path_header_box}
    -> ROText(-width=>49, -height=>10, relief=>'flat',
	      -wrap=>'none', -font=>$config{fonts}{fixed})
    -> pack();
  &disable_mouse3($widgets{path_header});
  my ($font, $red, $grey) = ($config{fonts}{fixedit}, $config{colors}{button}, $config{colors}{disabledforeground});
  $widgets{path_header} -> tagConfigure('absorber', -foreground=>$red);
  $widgets{path_header} -> tagConfigure('angles',   -font=>$font, -foreground=>$grey);
  #$widgets{path_header} -> insert('end', 'This box will contain the feffNNNN.dat header');

  ## Entry widgets for path parameters
  ##my $one_page = 1;		# 0=use NoteBook, 1=all on one page
  my ($fr2, $frind);
  ##if ($one_page) {
  my $labframe = $c -> LabFrame(-label	    => 'Path parameter math expressions',
				-font	    => $config{fonts}{med},
				-foreground => $config{colors}{activehighlightcolor},
				-labelside  => 'acrosstop')
    -> pack(-side=>'top', -pady=>3, -padx=>6, -fill=>'both', -expand=>1);
  $fr = $labframe -> Scrolled('Pane', -relief=>'flat', -borderwidth=>2,
			      -scrollbars=>'oe', -height=>1)
    -> pack(-expand=>1, -fill=>'both');
  $fr->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					  ($is_windows) ? () : (-width=>8));
  my $i = 0;
  ## feff
  foreach my $pp (qw(label S02 E0 delR sigma^2 Ei 3rd 4th dphase k_array phase_array amp_array)) {
    my $tn;
    if ($pp eq 'S02') {		# insert degen box
      $tn = $fr -> ROText()
	-> grid(-column=>0, -row=>$i, -sticky=>'e');
      $widgets{'path_me_N'} = $fr -> PathparamEntry(-width=>3, -validate=>'key',
						    -validatecommand=>[\&set_pathparam, 'N'])
	-> grid(-column=>1, -row=>$i, -sticky=>'w');
      $fr -> Label(@x)
	-> grid(-column=>2, -row=>$i);
      $t = $fr -> ROText()
	-> grid(-column=>3, -row=>$i, -sticky=>'w');
      $widgets{'path_me_'.$pp} = $fr -> PathparamEntry(-width=>30,
						       -validate=>'key',
						       -validatecommand=>[\&set_pathparam, $pp])
	-> grid(-column=>4, -row=>$i, -sticky=>'ew');
    } else {
      $t = $fr -> ROText()
	-> grid(-column=>0, -row=>$i, -sticky=>'e');
      $widgets{'path_me_'.$pp} = $fr -> PathparamEntry(-validate=>'key',
						       -validatecommand=>[\&set_pathparam, $pp])
	-> grid(-column=>1, -row=>$i, -sticky=>'ew', -columnspan=>4);
    };
    foreach my $tt ($tn, $t) {
      next unless $tt;
      $tt -> configure(-relief		  => 'flat',
		       -height		  => 1,
		       -width		  => ($pp eq 'S02') ? 4 : 11,
		       -highlightcolor	  => $config{colors}{background},
		       -selectbackground  => $config{colors}{background},
		       -selectforeground  => $config{colors}{activehighlightcolor},
		       -selectborderwidth => 0,
		       -foreground	  => $config{colors}{activehighlightcolor},
		       -font		  => $config{fonts}{med});
      my @t_bindtags = $tt -> bindtags;
      $tt -> bindtags([$t_bindtags[1]]); ## bindtags([@t_bindtags[1,0,2,3]]);
      $tt -> tagConfigure('label', -justify=>'right');
      $tt -> tagBind('label', "<Any-Enter>", sub {shift->configure(@bold)});
      $tt -> tagBind('label', "<Any-Leave>", sub {shift->configure(@normal)});
      ## button one echos a little help message unless a fit has been
      ## run and this path parameter has been evaluated, in which case
      ## the evaluation is echoed
      $tt -> tagBind('label', "<Button-1>",  sub {my $tt = shift->get(qw(1.0 end));
						  chomp $tt;
						  my $ttt = $click_help{$tt} || "$tt ???";
						  my $pp = substr($tt,0,-1);
						  my $p = ($pp eq 'delE0') ? 'E0' : $pp;
						  $ttt = join(" ",
							      $paths{$current}->descriptor() ,
							      "---",
							      $pp,
							      "evaluated to",
							      $paths{$current}->get("value_".lc($p)),
							      "in the last fit."
							     )
						    if ($paths{$current}->get("value_".lc($p)));
						  Echo($ttt); });
      $t -> tagBind('label', "<Button-3>", [\&post_pathparam_menu, $pp, Ev('X'), Ev('Y')]);
      $widgets{'path_lab_'.$pp} = $tt;
      ## button three to raise a menu for setting other pathparams
    };

    $widgets{'path_me_'.$pp} -> bind("<Button-3>", [\&snarf_variable, $pp,
						    Ev('x'), Ev('y'),
						    Ev('X'), Ev('Y')]);


    $tn and $tn -> insert('end', 'N:', 'label');
    $tn and $tn -> configure(-width=>10);
    my $ppp = $pp;
    $ppp = "delE0" if ($pp eq 'E0');
    $t -> insert('end', $ppp.':', 'label');
    ++$i;
  };
  #$fr -> gridColumnconfigure(1, -weight=>1);
  #$fr -> gridColumnconfigure(4, -weight=>1);

  &manage_extended_params;
  $c -> Frame()
    -> pack(-side=>'top', -pady=>3, -padx=>6, -fill=>'both', -expand=>1);
  $widgets{help_path} =
    $c-> Button(-text => "Document: Paths and path parameters", @button2_list,
		-command=>sub{pod_display("artemis_path.pod")},
	       )
      -> pack(-side=>'top', -pady=>3, -padx=>1, -fill=>'x',);


  return $c;
};


## this is the call-back for the checkbutton in the paths menu for
## showing the "extended path parameters".  These are the odd ones,
## dphase + (k|amp|phase)_array, which only the experts should be
## using. This sub hides them by gridForget-ing or replaces them by
## gridding them back onto the paths view.
sub manage_extended_params {
  my $row = 9;
  foreach my $p (qw(dphase k_array amp_array phase_array)) {
    if (($config{paths}{extpp}) and (not $widgets{'path_me_'.$p} -> gridInfo)) {
      $widgets{'path_lab_'.$p} ->
	grid(-column=>0, -row=>$row, -sticky=>'w', -columnspan=>4);
      $widgets{'path_me_'.$p} ->
	grid(-column=>1, -row=>$row++, -sticky=>'ew', -columnspan=>4);
    } elsif ((not $config{paths}{extpp}) and ($widgets{'path_me_'.$p} -> gridInfo)) {
      $widgets{'path_lab_'.$p} -> gridForget();
      $widgets{'path_me_'.$p} -> gridForget();
    };
  };
};


## this is the callback to a mouse-3 click in the entry box for math
## expressions on the path page
sub snarf_variable {
  my ($t, $p, $x, $y, $xm, $ym) = @_;
  return if (($p eq 'feff') or ($p eq 'label'));
  #$widgets{'path_me_'.$p}
  $t -> eventGenerate("<Button-1>", '-x'=>$x, '-y'=>$y);
  $t -> eventGenerate("<ButtonRelease-1>", '-x'=>$x, '-y'=>$y);
  $t -> MouseSelect($x,'word','sel.first');
  return unless $t -> selectionPresent;
  my $this = $t -> SelectionGet;
  $t -> selectionClear, return if ($this =~ /[- \t\n\r\f(),+*\/]/);
  $t -> selectionClear, return if ($this eq 'reff');
  $t -> selectionClear, return if ($this =~ /^(\d+\.?\d*|\.\d+)$/);
  $t -> selectionClear, return if ($this =~ /^($function_regex)$/);
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[
		      ['command' => "Make \`$this\' a guess and jump",
		       -command  => sub{&jump_to_variable($this, 'guess', 0)}],
		      ['command' => "Make \`$this\' a guess and stay",
		       -command  => sub{&jump_to_variable($this, 'guess', 1)}],
		      "-",
		      ['command' => "Make \`$this\' a def and jump",
		       -command  => sub{&jump_to_variable($this, 'def', 0)}],
		      ['command' => "Make \`$this\' a def and stay",
		       -command  => sub{&jump_to_variable($this, 'def', 1)}],
		      "-",
		      ['command' => "Make \`$this\' a set and jump",
		       -command  => sub{&jump_to_variable($this, 'set', 0)}],
		      ['command' => "Make \`$this\' a set and stay",
		       -command  => sub{&jump_to_variable($this, 'set', 1)}],
		      "-",
		      ['command' => "Make \`$this\' a skip and jump",
		       -command  => sub{&jump_to_variable($this, 'skip', 0)}],
		      ['command' => "Make \`$this\' a skip and stay",
		       -command  => sub{&jump_to_variable($this, 'skip', 1)}],
		     ]
	 ) ->Post($xm,$ym);
  $t -> break;
};


## and this disposes of the snarfed variable
sub jump_to_variable {
  my ($this, $gds, $stay, $value) = @_;
  my $which = -1;
  ## search for this variable ...
  my $see = 0;
  foreach (@gds) {
    ++$see;
    $which = $_, last if ($_->name =~ /^$this$/i);
  };
  ## or for the end of the list
  if ($which == -1) {
    push @gds, Ifeffit::Parameter->new(type=>$gds,
				       name=>$this,
				       mathexp=>'0',
				       bestfit=>0,
				       modified=>1,
				       note=>"$this: ",
				       autonote=>1,
				      );
    $see = $#gds;
    $which = $gds[$see];
    ++$see;
  };
  $which->make(type=>$gds,
	       modified=>1);
  Echo("Made \"$this\" a $gds parameter");
  if (defined $value) {
    $which->make(mathexp=>$value);
  } elsif ($stay) {
    $which->make(mathexp=>'0');
  };
  $which->make(note=>$which->name.": ") if ($which->note =~ /^\s*$/);
  repopulate_gds2();
  gds2_display($see);
  return if $stay;
  &display_page("gsd");
  project_state(0);
  $parameters_changed = 1;
};


## This sub posts the menu of path parameter operations when the path
## parameter label is mouse-3 clicked.
sub post_pathparam_menu {
  my ($t, $p, $X, $Y) = @_;
  #$p = $t->get(qw(1.0 end));
  #$p = substr($p, 0, index($p, ':'));
  my $pp = uc $p;
  if (@_ < 3) {
    my $e = $t->XEvent;
    ($X, $Y) = ($e->X, $e->Y);
  };

  my $d = $paths{$current}->data;
  my $f = $paths{$current}->get('parent');
  my @all = &all_data;
  my $ndata = $#all;
  @all = &all_feff;
  my $nfeff = $#all;
  @all = grep /^$d\.feff\d+$/, (keys %paths);
  my $this_nfeff = $#all;


  my $pathparam_menu = $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[#(($p eq 'feff') ?
		      # (['command' => "Read a feffNNNN.dat file",
		      #	 -command  => [\&Echo, "Read a feffNNNN.dat file"]],"-" ) : ()),
		      ['command' => "Edit $pp for many paths",
		       -command  => [\&add_mathexp, $p]],
		      ['command' => "Clear $pp for this path",
		       -command  => sub{$paths{$current}->get($p) = "";
					$widgets{'path_me_'.$p} -> delete(qw(0 end));
				        project_state(0);}],
		      "-",
		      ['command' =>
		       "Export this $pp to every path in THIS feff calculation",
		       -command  =>
		       [\&add_to_paths, $pp, $widgets{'path_me_'.$p}->get(), 'this']],
		      ['command' =>
		       "Export this $pp to every path in EACH feff with THIS data set",
		       -state => ($this_nfeff) ? 'normal' : 'disabled',
		       -command  =>
		       [\&add_to_paths, $pp, $widgets{'path_me_'.$p}->get(), 'data']],
		      ['command' =>
		       "Export this $pp to every path in EACH feff calculation",
		       -state => ($nfeff) ? 'normal' : 'disabled',
		       -command  =>
		       [\&add_to_paths, $pp, $widgets{'path_me_'.$p}->get(), 'each']],
		      ['command' =>
		       "Export this $pp to SELECTED paths",
		       -command  =>
		       [\&add_to_paths, $pp, $widgets{'path_me_'.$p}->get(), 'sel']],
		      "-",
		      ['command' => "Grab $pp from the previous path",
		       -command  => [\&grab_from_path, $p, 'prev']],
		      ['command' => "Grab $pp from the next path",
		       -command  => [\&grab_from_path, $p, 'next']],
		      (($p eq 'sigma^2') ?
		       ("-",
			['command' => "Insert Einstein function",
			 -command  => sub{sigsqr_model('eins') }],
			['command' => "Insert Debye function",
			 -command  => sub{sigsqr_model('debye')}],
		       ) : ())
		     ] );
  $pathparam_menu->Post($X,$Y);
  $t -> break;
};


sub populate_path {
  my $this   = $_[0];
  my $parent = $paths{$this}->get('parent');
  $widgets{path_header} -> delete(qw(1.0 end));
  my $i = 0;
  foreach my $l (split(/\n/, $paths{$this}->get('header'))) {
    ## the look-ahead assertion is required because it is easy to mix
    ## up the letter O and the number 0 in a feff potentials list
    if ($l =~ / 0 +(?=\w)/) {
      $widgets{path_header} -> insert('end', $l, 'absorber');
    } elsif ($l =~ /beta/) {
      $widgets{path_header} -> insert('end', $l, 'angles');
    } else {
      $widgets{path_header} -> insert('end', $l);
    };
    $widgets{path_header} -> insert('end', "\n");
    ++$i;
  };
  $widgets{path_header} -> configure(-height=>$i);
  my $label = $paths{$this}->get('intrpline');
  $widgets{path_header_box} -> configure(-label=>substr($label, index($label, ':')+1));

  $widgets{path_include} -> deselect();
  $widgets{path_include} -> select() if ($paths{$this}->get('include'));
  ##my $thislab = $paths{$this}->get('lab');
  ##($thislab = substr($thislab, 0, 15) . " ... ") if (length($thislab) > 16);
  ##$widgets{path_include} -> configure(-text=>"Include \`$thislab\' in the fit");

  $widgets{path_setpath} -> deselect();
  $widgets{path_setpath} -> select() if ($paths{$this}->get('setpath'));

  $widgets{path_plotpath} -> deselect();
  $widgets{path_plotpath} -> select() if ($paths{$this}->get('plotpath'));

  $widgets{path_label} -> configure(-text=>"  ".$paths{$this}->descriptor());

  ##feff
  foreach (qw(label N S02 E0 delR sigma^2 Ei 3rd 4th dphase k_array phase_array amp_array)) {
    my $key = "path_me_".$_;
    $widgets{$key} -> configure(-validate=>'none');
    $widgets{$key} -> delete(qw(0 end));
    $widgets{$key} -> insert(0, ($_ eq 'N') ?
			     $paths{$this}->get('deg') :
			     $paths{$this}->get(lc($_)));
    $widgets{$key} -> configure(-validate=>'key');
  };
};


sub set_pathparam {
  my ($k, $entry, $prop) = (shift, shift, shift);
#  print "$current $k $entry\n";
  (lc($k) eq 'n') and ($entry !~ /^(|\d+\.?\d*|\.\d+)$/) and return 0;
  $paths{$current} -> make(lc($k)=>$entry);
  (lc($k) eq 'feff') and $paths{$current} -> make(file=>$entry);
  (lc($k) eq 'n')    and $paths{$current} -> make(deg =>$entry);
  unless (($entry eq 'label') or ($entry eq 'header')) {
    $paths{$current} -> make(do_k=>1);
  };
  project_state(0);
  return 1;
  ## need to flag that fit needs to be redone and that project needs
  ## to be saved
};


sub add_a_path {
  my $data = $paths{$current}->data;
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;
  my $path = $current_data_dir || cwd;
  my $types = [['feffNNNN.dat files', 'feff*.dat'],
	       ['All Files', '*'],];
  my $file      = $_[0];
  my $noanchor  = $_[1];
  my $force_new = $_[2];
  ($file and (-e $file)) or
    ($file = $top -> getOpenFile(-filetypes=>$types,
				 ##(not $is_windows) ?
				 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				   -initialdir=>$path,
				 -title => "Artemis: Open a feffNNNN.dat file"));
  return unless ($file);
  Error("\"$file\" is not a feffNNNN.dat file"), return unless Ifeffit::Files->is_feffnnnn($file);
  my ($name, $feff_path, $suffix) = fileparse($file);
  ($current_data_dir = $feff_path) unless sub_directory($feff_path, $project_folder);

  my $id = '';
  ## need to figure out if this path is from a calculation that has
  ## already been used with this data set
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'feff');
    next unless same_directory($paths{$k}->get('path'), $feff_path);
    next unless ($paths{$k}->data eq $data);
    $id = $paths{$k}->get('id');
    last;
  };

  if ($force_new or (not $id)) {
    $id = $data . '.feff' . $n_feff;

##     ## import this feff calc into the project by copying all files
##     ## &initialize_project(0);
##     my $project_feff_dir = &initialize_feff($id);
##     ## copy all these feff files to the project feff folder
##     opendir F, $feff_path;
##     my @list = grep { (-f File::Spec->catfile($feff_path,$_)) and
## 			(lc($_) =~ /\.(bin|dat|inp|log|run)$/) } readdir F;
##     closedir F;
##     map { copy(File::Spec->catfile($feff_path,$_), $project_feff_dir) } @list;
##     ## make sure that the feff.inp file is "feff.inp"
##     copy($file, File::Spec->catfile($project_feff_dir, 'feff.inp'));

    ## instantiate and list a new feff object
    $paths{$id} = Ifeffit::Path -> new(id     => $id,
				       lab    => 'FEFF'.$n_feff,
				       type   => 'feff',
				       path   => $feff_path,
				       data   => $data,
				       family => \%paths);
    $paths{$id}->make(mode=>2) if (-e $paths{$id}->get('feff.inp'));
    my @autoparams;
    $#autoparams = 6;
    (@autoparams = autoparams_define($id, $n_feff, 0, 0)) if $config{autoparams}{do_autoparams};
    $paths{$id} -> make(autoparams=>[@autoparams]);
    $list -> add($id, -text=>'FEFF'.$n_feff, -style=>$list_styles{noplot});
    $list -> setmode($id, 'close');
    $list -> setmode($data, 'close') if ($list->getmode($data) eq 'none');
    my $intrp_ok = &do_intrp($id);
    $paths{$id} -> make(mode=>$paths{$id}->get('mode')+4) if $intrp_ok;
    ++$n_feff;
  };

  my $descr = $paths{$id}->descriptor();
  Echo("Adding $descr ...");
  #my $kid = $list -> addchild($id); #, -after=>$current);
  my $kid = fetch_nnnn($id, $feff_path, $name);
  $list -> entryconfigure($kid,
			  -style => $list_styles{$paths{$kid}->pathstate("enabled")},
			  -text  => $paths{$kid}->get('lab'));
  display_page($kid) unless $noanchor;
  Echo("Adding $descr ... done!");
  return $kid;
};



sub rename_path {
  Error("This isn't a path."), return unless ($paths{$current}->type eq 'path');
  my $this = $paths{$current}->get('lab');
  my $newname = $this;
  my $label = "New name for path \"".$paths{$paths{$current}->get('parent')}->get('lab').": $this\": ";
  my $dialog = get_string($dmode, $label, \$newname, \@rename_buffer);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Not renaming ". $this), return if ($this eq $newname);
  $newname =~ s{[\"\']}{}g;
  push @rename_buffer, $newname;
  project_state(0);
  $paths{$current} -> make(lab=>$newname);
  $list -> itemConfigure($current, 0, -text=>$newname);
  $widgets{path_label} -> configure(-text=>"  ".$paths{$current}->descriptor());
};


sub clone_this_path {
  my $old    = $paths{$current}->get('lab');
  my $parent = $paths{$current}->get('parent');
  my $this = $list -> addchild($parent, -after=>$current);
  $paths{$this} = Ifeffit::Path -> new(id       => $this,
				       type     => 'path',
				       family   => \%paths,
				       plotpath => 0);
  foreach my $k (keys %{$paths{$current}}) {
    next if ($k =~ /(id|type|group|file)/);
    $paths{$this}->make($k=>$paths{$current}->get($k));
  };

  my $lab = $paths{$this}->pathlabel($old);
  #$paths{$this}->make(lab=>$lab);

  ## halve the degeneracy of the current and the clone
  $paths{$this}->make(deg=>$paths{$current}->get('deg')/2);
  $paths{$current}->make(deg=>$paths{$this}->get('deg'));

  $list -> entryconfigure($this,
			  -style => $list_styles{$paths{$this}->pathstate("enabled")},
			  -text  => $lab);
  $paths{$this} -> pathgroup(\%paths);
  display_page($this);
  Echo("Cloned $old and called it \"$lab\"");
};




sub toggle_include {
  $paths{$current}->make(include=> not $paths{$current}->get('include'));
  project_state(0);
  my $this = $paths{$current}->data;
  return unless $paths{$this}->{include};
  my $style = $list_styles{$paths{$current}->pathstate};
  $list -> entryconfigure($current, -style => $style);
  $paths{$current}->get('include') ?
    Echo("Include " . $paths{$current}->descriptor() . " in the fit.") :
      Echo("Exclude " . $paths{$current}->descriptor() . " from the fit.");
};

sub toggle_plotpath {
  $paths{$current}->make(plotpath=> not $paths{$current}->get('plotpath'));
  project_state(0);
};
sub set_plotpath {
  my ($which, $val) = @_;
  $paths{$which}->make(plotpath=>$val);
  project_state(0);
};


sub set_path_index {
  my $which = $_[0];
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq "path");
    $paths{$k}->make(setpath => 0);
  };
  $paths{$which}->make(setpath => 1);
  Echo($paths{$which}->descriptor() . " marked as Ifeffit's current path");
};

## return the one marked as the default or the first included path if
## the default is not included
sub which_set_path {
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq "path");
    return $k if (($paths{$k}->get('setpath')) and $paths{$k}->get('include'));
  };
  foreach my $k (sort (keys %paths)) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq "path");
    return $k if $paths{$k}->get('include');
  };
};


###===================================================================
### math expression utilities
###===================================================================

sub add_mathexp {
  my $which = $_[0];
  my $red = $config{colors}{check};
  my $calcs = 'this';
  my $ren = $top -> Toplevel(-title=>'Artemis: read math expression', -class=>'horae');
  $ren -> protocol(WM_DELETE_WINDOW => sub{$ren->destroy;});
  #$ren -> iconbitmap('@'.$iconbitmap);
  $ren -> iconimage($iconimage);
  $ren -> Label(-text=>"Math expression for $which",
		-foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top');
  my $entry = $ren -> Entry(-justify=>'left',-width=>50)
    -> pack(-side=>'top', -expand=>1, -fill=>'x', -padx=>10);
  $entry -> insert('end', $widgets{'path_me_'.$which}->get) if ($paths{$current}->type eq 'path');
  $entry -> selectionRange(qw(0 end));
  $entry -> bind("<KeyPress-Return>",
		 sub{&add_to_paths($which, $entry->get(), $calcs); $ren->destroy;});

  # buttons at the bottom
  my @props = (-selectcolor=>$red,
	       -foreground=>$config{colors}{activehighlightcolor});
  my $fr = $ren -> Frame(-relief=>'flat')
    -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
  $fr -> Button(-text=>'Document: edit math expression',  @button2_list,
		-command=>sub{pod_display("artemis_editme.pod")})
    -> pack(-side=>'right', -expand=>1, -fill=>'x');
  $fr = $ren -> Frame(-relief=>'flat')
    -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
  $fr -> Button(-text=>'OK',  @button2_list,
		-command=>sub{&add_to_paths($which, $entry->get(), $calcs); $ren->destroy;})
    -> pack(-side=>'left', -expand=>1, -fill=>'x');
  $fr -> Button(-text=>'Cancel',  @button2_list,
		-command=>sub{$ren->destroy;})
    -> pack(-side=>'right', -expand=>1, -fill=>'x');
  ## this radio above the buttons
  $fr = $ren -> Frame(-relief=>'flat')
    -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
  my $data = $fr -> Radiobutton(-text=>'Add to EACH feff in THIS data set', @props,
		     -activeforeground=>$config{colors}{activehighlightcolor},
		     -value=>'data', -variable=>\$calcs)
    -> pack(-side=>'left');
  my $sel = $fr -> Radiobutton(-text=>'Add to all selected paths', @props,
		     -activeforeground=>$config{colors}{activehighlightcolor},
		     -value=>'sel', -variable=>\$calcs)
    -> pack(-side=>'right');
  ## and these radios underneath entry box
  $fr = $ren -> Frame(-relief=>'flat')
    -> pack(-side=>'bottom', -expand=>1, -fill=>'x');
  my $this = $fr -> Radiobutton(-text=>'Add to THIS feff calculation only', @props,
		     -activeforeground=>$config{colors}{activehighlightcolor},
		     -value=>'this', -variable=>\$calcs)
    -> pack(-side=>'left');
  my $each = $fr -> Radiobutton(-text=>'Add to EACH feff calculation', @props,
				-activeforeground=>$config{colors}{activehighlightcolor},
				-value=>'each', -variable=>\$calcs)
    -> pack(-side=>'right');

  ## disable the radiobuttons as appropriate
  my $d = $paths{$current}->data;
  my $f = $paths{$current}->get('parent');
  my @all = &all_data;
  ($#all) or ($data -> configure(-state=>'disabled'));
  @all = &all_feff;
  ($#all) or ($each -> configure(-state=>'disabled'));
  @all = grep /^$d\.feff\d+$/, (keys %paths);
  ($#all) or ($data -> configure(-state=>'disabled'));

  $entry -> focus;
  my $str = sprintf("+%d+%d", 0.35*$top->screenwidth(), 0.4*$top->screenheight());
  $ren -> geometry($str);
  $ren -> raise;
  $ren -> grab;
};

## this data each sel
sub add_to_paths {
  my ($which, $mathexp, $calcs) = @_;
  my ($dt, $f, $curr) = split(/\./,$current);
  my $data = $paths{$current}->data;
  my $feff = $paths{$current}->feff; #get('parent');
  my $message = "";
  if ($mathexp eq '^^clear^^') {
    $mathexp = "";
    $message = "Cleared \`$which\' for all paths.";
  };
  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless ($paths{$p}->type eq "path");
    my %tokens = (i => $paths{$p}->get('feff_index'),
		  I => sprintf("%4.4d", $paths{$p}->get('feff_index')),
		  r => $paths{$p}->get('reff'),
		  d => $paths{$p}->get('deg'),
		  D => "debye(temp, thetad)",
		  E => "eins(temp, thetae)",
		 );
    (my $mesub = $mathexp) =~ s/\%([iIrdDE])/$tokens{$1}/g;
  SWITCH: {
      ($calcs eq 'this') and do { # this feff calculation
	last SWITCH unless ($paths{$p}->get('parent') eq $feff); # this or each?
	$paths{$p} -> make($which, $mesub);
	$message = "Set \`$which\' to \`$mathexp\' in all paths in this feff calculation.";
	last SWITCH;
      };
      ($calcs eq 'data') and do { # all feff calcs with this data set
	last SWITCH unless ($paths{$p}->data eq $data);
	$paths{$p} -> make($which, $mesub);
	$message = "Set \`$which\' to \`$mathexp\' in all paths for this data set.";
	last SWITCH;
      };
      ($calcs eq 'each') and do { # all feff calcs used
	$paths{$p} -> make($which, $mesub);
	$message = "Set \`$which\' to \`$mathexp\' in all paths in each feff calculation.";
	last SWITCH;
      };
      ($calcs eq 'sel') and do { # selected paths
	last SWITCH unless  grep {$p eq $_} $list->info('selection');
	$paths{$p} -> make($which, $mesub);
	$message = "Set \`$which\' to \`$mathexp\' in the selected paths.";
	last SWITCH;
      };
    };
  };
  display_properties;
  project_state(0);
  Echo($message);
};

## copy all path parameters from current to others
sub copy_pps {
  my $how = $_[0];
  my $data = $paths{$current}->data;
  my $feff = $paths{$current}->feff;

  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless ($paths{$p}->type eq "path");

    next if (($how eq 'this') and ($paths{$p}->feff ne $feff));
    next if (($how eq 'data') and ($paths{$p}->data ne $data));
    next if (($how eq 'sel')  and not (grep {$p eq $_} $list->info('selection')));

    foreach (qw(label S02 E0 delR sigma^2 Ei 3rd 4th dphase k_array phase_array amp_array)) {
      my $exp = $widgets{'path_me_'.$_}->get();
      $paths{$p} -> make($_, $exp);
    };

  };
  my $which = "paths in this Feff calculation";
  ($which = "paths for this data set") if ($how eq 'data');
  ($which = "all paths")               if ($how eq 'each');
  ($which = "selected paths")          if ($how eq 'sel');
  Echo("Set all parameters for $which to the values of the current path");
};


sub grab_from_path {
  my ($p, $which) = @_;
  my $from = $list->info($which, $current);
  ## exception handling
  Echo("This is the last path"), return if (not $from and ($which eq 'next'));
  Echo("This is the last path in this feff calculation"), return
    if (($from =~ /^feff\d+$/)  and ($which eq 'next'));
  Echo("This is the first path in this feff calculation"), return
    if (($from =~ /^feff\d+$/)  and ($which eq 'previous'));
  ## insert the value
  my $value = $paths{$from} -> get(lc($p));
  ($which eq 'prev') and ($which = 'previous');
  Echo("The $which value of $p is blank"), return unless (defined $value);
  Echo("The $which value of $p is blank"), return if ($value =~ /^\s*$/);
  $paths{$current} -> make($p => $value);
  $widgets{'path_me_'.$p} -> delete(0, 'end');
  $widgets{'path_me_'.$p} -> insert('end', $value);
  $widgets{'path_me_'.$p} -> icursor('end');
  $widgets{'path_me_'.$p} -> focus();
  project_state(0);
  my $pp = uc $p;
  Echo("Grabbed \`$value\' for $pp from the $which path");
};


sub select_paths {
  my ($how, $crit, $nodisplay) = @_;
  my ($data, $feff, $curr) = split(/\./,$current);
  $feff = ($current =~ /(feff\d+)/) ? $1 : "";
  my $parent;
  my $this = $current;

  ## get the list of paths that follow the current one in the list,
  ## but which are still of the same feff calculation.  this is done
  ## for the sake of "exclude after current".  This way cloned
  ## paths, which have a higher X as in dataN.feffM.X are considered
  ## in their place in the list
  my @following = ();
  if ($paths{$current}->type eq 'path') {
    my $pth = $current;
    while ($list->infoNext($pth)) {
      $pth = $list->infoNext($pth);
      push(@following, $pth)
	if (($paths{$pth}->type eq 'path') and
	    ($paths{$pth}->get('parent') eq $paths{$current}->get('parent')));
    };
  };

  $parent = $paths{$current}->feff;
  return unless $parent;

  my $message;
  if (($how eq 'nlegs') and (not $crit)) {
    $crit = &get_nlegs;
    Echo("Canceling path selection"), return if ($crit eq 'Cancel');
    Echo("Selecting all paths of $crit legs and fewer");
  } elsif (($how eq 'r') and (not $crit)) {
    $crit = &get_r;
    Echo("Canceling path selection"), return if ($crit eq 'Cancel');
    Echo("Selecting all paths of distance $crit and shorter");
  } elsif (($how eq 'amp') and (not $crit)) {
    $crit = &get_zcwif;
    Echo("Canceling path selection"), return if ($crit eq 'Cancel');
    Echo("Selecting all paths of amplitude $crit and higher");
  };

  ## check the data this path is associated with to see if it is
  ## included in the fit

  if ($how eq 'toggle')  {
    my $data = $paths{$crit}->data;
    $paths{$crit}->make(include => not $paths{$crit}->get('include'));
    if ($paths{$data}->get('include')) {
      $list -> entryconfigure($paths{$crit}->get('id'),
			      -style=>$list_styles{$paths{$crit}->pathstate});
    };
    my $onoff = ($paths{$crit}->get('include')) ? 'on' : 'off';
    $message  = "Toggled $onoff \"" . $paths{$crit}->descriptor() .
      "\" for fitting.";
  } elsif ($how eq 'on')  {
    my $data = $paths{$crit}->data;
    $paths{$crit}->make(include => 1);
    if ($paths{$data}->get('include')) {
      $list -> entryconfigure($paths{$crit}->get('id'),
			      -style=>$list_styles{$paths{$crit}->pathstate("enabled")});
    };
    $message  = "Toggled on \"" . $paths{$crit}->descriptor() . "\" for fitting.";
  } elsif ($how eq 'off')  {
    my $data = $paths{$crit}->data;
    $paths{$crit}->make(include => 0);
    if ($paths{$data}->get('include')) {
      $list -> entryconfigure($paths{$crit}->get('id'),
			      -style=>$list_styles{$paths{$crit}->pathstate("disabled")});
    };
    $message  = "Toggled off \"" . $paths{$crit}->descriptor() . "\" for fitting.";
  } else {
    foreach my $p (keys %paths) {
      next unless (ref($paths{$p}) =~ /Ifeffit/);
      next unless ($paths{$p}->type eq 'path');
    SWITCH: {
	($how =~ /^all/) and do {
	  last SWITCH if (($how =~ /this/) and ($p !~ /$parent/));
	  $paths{$p} -> make(include=>1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style => $list_styles{$paths{$p}->pathstate("enabled")});
	  };
	  $message = "Included all paths for fitting.";
	  last SWITCH;
	};
	($how =~ /^none/) and do {
	  last SWITCH if (($how =~ /this/) and ($p !~ /$parent/));
	  $paths{$p} -> make(include=>0);
	  $list -> entryconfigure($paths{$p}->get('id'),
				  -style => $list_styles{$paths{$p}->pathstate("disabled")});
	  $message = "Excluded all paths from fitting.";
	  last SWITCH;
	};
	($how =~ /^invert/) and do {
	  last SWITCH if (($how =~ /this/) and ($p !~ /$parent/));
	  $paths{$p} -> make(include=>($paths{$p}->get('include')) ? 0 : 1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate});
	  };
	  $message = "Inverted the included paths.";
	  last SWITCH;
	};
	($how eq 'current') and do {
	  last SWITCH if ($paths{$p}->get('parent') ne $parent);
	  $paths{$p} -> make(include=>(grep /^$p$/, @following) ? 0 : 1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate});
	  };
	  $message = "Excluded all paths after \"" .
	    $paths{$current}->descriptor() . "\" from fitting.";
	  last SWITCH;
	};
	($how eq 'nlegs') and do {
	  last SWITCH if ($paths{$p}->get('parent') ne $parent);
	  $paths{$p} -> make(include=>($paths{$p}->get('nleg') > $crit) ? 0 : 1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate});
	  };
	  $message = "Excluded all paths with more than $crit legs from fitting.";
	  last SWITCH;
	};
	($how eq 'r') and do {
	  last SWITCH if ($paths{$p}->get('parent') ne $parent);
	  $paths{$p} -> make(include=>($paths{$p}->get('reff')>$crit) ? 0 : 1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate});
	  };
	  $message = "Excluded all paths longer than $crit from fitting.";
	  last SWITCH;
	};
	($how eq 'amp') and do {
	  last SWITCH if ($paths{$p}->get('parent') ne $parent);
	  $paths{$p} -> make(include=>($paths{$p}->get('zcwif')<$crit) ? 0 : 1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate});
	  };
	  $message = "Excluded all paths with amplitude smaller than $crit from fitting.";
	  last SWITCH;
	};
	($how eq 'selon') and do {
	  my $selected = grep {$p eq $_} $list->info('selection');
	  last SWITCH unless ($selected);
	  $paths{$p} -> make(include=>1);
	  my $data = $paths{$p}->data;
	  if ($paths{$data}->get('include')) {
	    $list -> entryconfigure($paths{$p}->get('id'),
				    -style=>$list_styles{$paths{$p}->pathstate("enabled")});
	  };
	  $message = "Included selected paths for fitting.";
	  last SWITCH;
	};
	($how eq 'seloff') and do {
	  my $selected = grep {$p eq $_} $list->info('selection');
	  last SWITCH unless ($selected);
	  $paths{$p} -> make(include=>0);
	  $list -> entryconfigure($paths{$p}->get('id'),
				  -style=>$list_styles{$paths{$p}->pathstate("disabled")});
	  $message = "Excluded selected paths from fitting.";
	  last SWITCH;
	};
      }; # end of SWITCH
    }; # end of loop over paths
  }; # end of if/else
  display_properties unless $nodisplay;
  project_state(0);
  Echo($message);
};


sub plot_path {
  my $these = $_[0];
  my $space = $_[1];
  my $data = $paths{$these->[0]}->data;
  $list->selectionClear;
  $list->selectionSet($data);
  foreach my $p (@$these) {
    $list->selectionSet($p);
  };
  &plot($space, 0);
};

sub set_degeneracy {
  my $how = $_[0];
  my $this = ($paths{$current}->type eq 'feff') ? $current : $paths{$current}->get('parent');
 SWITCH: {
    ($how eq '1') and do {
      foreach my $p (keys %paths) {
	next unless (ref($paths{$p}) =~ /Ifeffit/);
	next unless ($paths{$p}->type eq 'path');
	next unless ($paths{$p}->get('parent') eq $this);
	$paths{$p} -> make(deg=>1);
      };
      Echo('All degeneracies were set to 1 for "' . $paths{$this}->descriptor . '"');
      last SWITCH;
    };
    ($how eq 'feff') and do {
      my $pathto = $paths{$this}->get('path');
      Echo("You need to reset the path to FEFF"), return unless (-d $pathto);
      $top -> Busy;
      foreach my $p (keys %paths) {
	next unless (ref($paths{$p}) =~ /Ifeffit/);
	next unless ($paths{$p}->type eq 'path');
	next unless ($paths{$p}->get('parent') eq $this);
	my $file = File::Spec->catfile($pathto, $paths{$p}->get('feff'));
	next unless (-e $file);
	my $degen;
	open F, $file or die "could not open feffNNNN.dat file $file for reading\n";
	while (<F>) {
	  next unless (/nleg, deg, reff/);
	  $degen = (split(" ", $_))[1];
	  last;
	};
	close F;
	$paths{$p} -> make(deg=>int($degen));
      };
      $top -> Unbusy;
      Echo('All degeneracies were reset to their values from FEFF');
      last SWITCH;
    };
  };
  display_properties;
  project_state(0);
};


sub sigsqr_model {
  my $name  = ($_[0] eq 'eins') ? "Einstein" : "Debye";
  my $which = ($_[0] eq 'eins') ? "bond" : "material";

  ## use the autoparameter suffix for this feff calc
  my $parent = $paths{$current}->get('parent');
  my $suffix = "";
  ($suffix = $1) if  ($paths{$parent}->{autoparams}->[0] =~ /(_.+)/);
  my $theta = ($_[0] eq 'eins') ? "thetae" : "thetad";
  my $value = $_[0] . "(temp$suffix, $theta$suffix)";

  ## define the guess and set parameters if needed
  my $found = 0;
  map { ++$found if (lc($_->name) eq "temp$suffix") } (@gds);
  unless ($found) {
    push @gds, Ifeffit::Parameter->new(type=>"set",
				       name=>"temp$suffix",
				       mathexp=>"300",
				       bestfit=>"300",
				       modified=>1,
				       note=>"The temperature of the measurement",
				       autonote=>0,
				      );
    my $row = $#gds+1;
    $widgets{gds2list} -> add($row);
    $widgets{gds2list} -> itemCreate($row, 0, -text=>$row,          -style=>$gds_styles{set});
    $widgets{gds2list} -> itemCreate($row, 1, -text=>"s:",          -style=>$gds_styles{set});
    $widgets{gds2list} -> itemCreate($row, 2, -text=>"temp$suffix", -style=>$gds_styles{set});
    $widgets{gds2list} -> itemCreate($row, 3, -text=>"300",         -style=>$gds_styles{set});
  };
  $found = 0;
  map { ++$found if (lc($_->name) eq "$theta$suffix") } (@gds);
  unless ($found) {
    push @gds, Ifeffit::Parameter->new(type=>"guess",
				       name=>"$theta$suffix",
				       mathexp=>"350",
				       bestfit=>"350",
				       modified=>1,
				       note=>"The $name temperature of the $which",
				       autonote=>0,
				      );
    my $row = $#gds+1;
    $widgets{gds2list} -> add($row);
    $widgets{gds2list} -> itemCreate($row, 0, -text=>$row,            -style=>$gds_styles{guess});
    $widgets{gds2list} -> itemCreate($row, 1, -text=>"g:",            -style=>$gds_styles{guess});
    $widgets{gds2list} -> itemCreate($row, 2, -text=>"$theta$suffix", -style=>$gds_styles{guess});
    $widgets{gds2list} -> itemCreate($row, 3, -text=>"350",           -style=>$gds_styles{guess});
  };

  ## define the path parameter
  $paths{$current} -> make('sigma^2' => $value);
  $widgets{'path_me_sigma^2'} -> delete(0, 'end');
  $widgets{'path_me_sigma^2'} -> insert('end', $value);

  Echo("Using the $name model for this path.");
};


###===================================================================
### deletion of project parts
###===================================================================

sub delete_path {
  #Echo("Want to delete paths -- $_[0].");

  my ($how, $crit) = @_;
  my $redisplay = 1;
  my ($data, $feff, $curr) = split(/\./,$current);
  $feff = ($current =~ /feff(\d+)/) ? $1 : "";
  my $message = "No paths were deleted!";
  if ($how eq 'nlegs') {
    $crit = &get_nlegs;
    return if ($crit eq 'Cancel');
  } elsif ($how eq 'r') {
    $crit = &get_r;
    return if ($crit eq 'Cancel');
  } elsif ($how eq 'amp') {
    $crit = &get_zcwif;
    return if ($crit eq 'Cancel');
  };

  ## get the list of paths that follow the current one in the list,
  ## but which are still of the same feff calculation.  this is done
  ## for the sake of "discard after current".  This way cloned
  ## paths, which have a higher X as in dataN.feffM.X are considered
  ## in their place in the list
  my @following = ();
  if ($paths{$current}->type eq 'path') {
    my $pth = $current;
    while ($list->info("next",$pth)) {
      $pth = $list->info("next",$pth);
      push(@following, $pth)
	if (($paths{$pth}->type   eq 'path') and
	    ($paths{$pth}->get('parent') eq $paths{$current}->get('parent')));
    };
  };

  my $new = ($paths{$current}->type eq 'feff') ? $current : $paths{$current}->get('parent');
  #($how eq 'nlegs') and ($new = $paths{$current}->feff.".0");
  ($how eq 'current') and ($new = $current); # not strictly correct
  my @delete_them;
  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless ($paths{$p}->type eq 'path');
  SWITCH: {
      ($how eq 'all') and do {
	push @delete_them, $p;
	$message = "Discarded all paths";
	last SWITCH;
      };
      ($how eq 'this') and do {
	next unless ($p eq $current);
	$new   = $list->info('next', $p);
	$new ||= $list->info('prev', $p);
	push @delete_them, $p;
	$message = "Discarded path \"" . $paths{$current}->descriptor() . "\"";
	last SWITCH;
      };
      ($how eq 'r') and do {
	if ($paths{$p}->get('reff') < $crit) {
	  $new = $p;
	} else {
	  push @delete_them, $p;
	};
	$message = "Discarded all paths with more than $crit legs";
	last SWITCH;
      };
      ($how eq 'amp') and do {
	if ($paths{$p}->get('zcwif') > $crit) {
	  $new = $p;
	} else {
	  push @delete_them, $p;
	};
	$message = "Discarded all paths with amplitude less than $crit";
	last SWITCH;
      };
      ($how eq 'nlegs') and do {
	next unless ($paths{$p}->get('nleg') > $crit);
	push @delete_them, $p;
	$message = "Discarded all paths longer than $crit";
	last SWITCH;
      };
      ($how eq 'current') and do {
	## my $this = (split(/\./,$p))[2];
	## next if ($this<=$curr);
	push @delete_them, $p if (grep /^$p$/, @following);
	$message = "Discarded all paths after \"" . $paths{$current}->descriptor() . "\"";
	last SWITCH;
      };
      ($how eq 'sel') and do {
	my $selected = grep {$p eq $_} $list->info('selection');
	next unless $selected;
	push @delete_them, $p;
	$message = "Discarded all selected paths.";
	last SWITCH;
      };
      (exists $paths{$how}) and do {
	$redisplay = 0;
	next unless ($p eq $how);
	push @delete_them, $p;
	$message = "Discarded path \"" . $paths{$current}->descriptor() . "\"";
	last SWITCH;
      };
    };
  };
  ## clean up evidence of deleted paths
  foreach my $p (@delete_them) {
    $list->delete('entry',$p);
    ##($paths{$p}->get('group')) and
    $paths{$p}->dispose("erase \@group ".$paths{$p}->get('group'), $dmode) if $paths{$p}->get('group');
    $paths{$p}->drop;		# release it's index
    delete $paths{$p};
    project_state(0);
  };
  if ($redisplay) {
    $current = $new;
    $list->focus();
    display_page($new);
  };
  Echo($message);
  return;
};



sub show_path {
  if ($paths{$current}->type eq "path") {
    my $error = "";
    $error   .= &verify_parens;
    if ($error) {
      post_message($error, "Error Messages");
      Error("cannot show path due to errors in parameters and math expressions");
      return;
    };
    ##&read_gds2(1);
    my $command = "";
    if ($parameters_changed) {
      map { $command .= $_ -> write_gsd } (@gds);
      $parameters_changed = 0;
    };

    #my $n = $1 + 1;
    my $ii = $paths{$current}->index;
    my $pathto = $paths{$current}->get('path');
    $command .= $paths{$current} -> write_path($ii, $pathto, $config{paths}{extpp}, $stash_dir);
    $paths{$current} -> dispose($command, $dmode);
    &show_things('path '.$ii);
    $paths{$current} ->dispose("get_path($ii, t___emp)", 1);
    my $r = sprintf ("%.6f", Ifeffit::get_scalar("t___emp_reff") +
		     Ifeffit::get_scalar("t___emp_delr"));
    $paths{$current} ->
      dispose("### ifeffit group for path $ii = ".$paths{$current}->get('group'), $dmode)
	if ($paths{$current}->get('group'));
    foreach (qw(s02 e0 ei delr sigma2 third fourth degen reff)) {
      $paths{$current} ->dispose("erase t___emp_$_", 1);
    };
    Echo("Showing path \"" . $paths{$current}->descriptor() . "\"");
  }
};


sub display_path_header {
  my $this = $_[0];
  $notes{messages} -> delete(qw(1.0 end));
  $notes{messages} -> insert('end', $paths{$this}->descriptor(), "bold");
  $notes{messages} -> insert('end', "\n\n");
  foreach my $l (split(/\n/, $paths{$this}->get('header'))) {
    if ($l =~ / 0 /) {
      #print "abs\n";
      $notes{messages} -> insert('end', $l, 'absorber');
    } elsif ($l =~ /beta/) {
      #print "angle\n";
      $notes{messages} -> insert('end', $l, 'angles');
    } else {
      #print "nothing\n";
      $notes{messages} -> insert('end', $l);
    };
    $notes{messages} -> insert('end', "\n");
  };
  $top      -> update;
  raise_palette('messages');
  Echo("Showing header for \"" . $paths{$this}->descriptor() . "\"");
};

sub verify_number_of_paths {
  my $message = "";
  my $total = 0;
  my %seen;
  foreach my $d (&all_data) {
    my $n = 0;
    foreach my $k (keys %paths) {
      next unless (ref($paths{$k}) =~ /Ifeffit/);
      next unless ($paths{$k}->type eq "path");  # not a path
      next unless ($paths{$k}->data eq $d);	   # not from this data set
      next unless  $paths{$k}->get('include');	   # not included in the fit
      ++$n;
      ++$total;
    };
    if ($n > $limits{paths_per_set}) {
      $message .= "You have exceeded the per-path limit of $limits{paths_per_set} paths in data set\n";
      $message .= "\t" . $paths{$d}->descriptor();
    };
  };
  if ($total > $limits{total_paths}) {
    $message .= "You have used $total paths, exceeding Ifeffit's total-fit limit of $limits{total_paths} paths.\n";
  };
};


## this returns the list of paths in the order that they are
## displayed.
sub path_list {
  my $this = 'gsd';
  my @foo = ($this);
  while ($list->infoNext($this)) {
    $this = $list->infoNext($this);
    push @foo, $this;
  };
  return @foo;
};


## this returns a list of the first 5 paths in each feff calculation
## for a data set
sub pcpath_list {
  my $data = $_[0];
  my $this = 'gsd';
  my $count = 0;
  my @foo = ($this);
  while ($list->infoNext($this)) {
    $this = $list->infoNext($this);
    next unless (ref($paths{$this}) =~ /Ifeffit/);
    ($count = 0) if ($paths{$this}->type eq 'feff');
    next unless ($paths{$this}->type eq 'path');
    next unless ($paths{$this}->data eq $data);
    ++$count;
    next if ($count > 5);
    push @foo, $this;
  };
  return @foo;
};

sub path_used {
  my ($path, $file) = @_;
  foreach my $p (keys %paths) {
    next unless ($paths{$p}->type eq 'path');
    my $thispath = File::Spec->catfile($project_folder, $paths{$p}->get('parent'));
    next unless same_directory($thispath, $path);
    next unless ($file eq $paths{$p}->get('feff'));
    return 1;
  };
  return 0;
};


##  END OF THE SECTION ON THE PATH PAGE

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##

###===================================================================
### file I/O
###===================================================================

sub open_file {
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;
  my $path = $current_data_dir || cwd;
  ##print ">>> --$from_project--    --$current_data_dir--   --$path--\n";
  my @atoms_ext = ($STAR_Parser_exists) ? ('*.inp', '*.cif') : ('*.inp');
  my $types = [['All Artemis file types', ['*.prj', '*.chi', '*.apj', @atoms_ext]],
	       ['Athena projects',         '*.prj'],
	       ['chi(k) data',             '*.chi'],
	       ['Artemis projects',        '*.apj'],
	       ['Atoms/Feff input files', [@atoms_ext]],
	       ['All files',        '*'],];
  my $file = $top -> getOpenFile(-filetypes=>$types,
				 ##(not $is_windows) ?
				 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -title => "Artemis: Open a file");
  return unless ($file);
  Error("$file does not exist!"), return unless (-e $file);
  track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
 SWITCH: {
    import_atoms($file), last SWITCH if ($STAR_Parser_exists and Ifeffit::Files->is_cif($file));
    import_atoms($file), last SWITCH if (Ifeffit::Files->is_atoms($file));
    read_feff($file),    last SWITCH if (Ifeffit::Files->is_feff($file));
    read_athena($file),  last SWITCH if (Ifeffit::Files->is_athena($file));
    read_data(0, $file), last SWITCH if (Ifeffit::Files->is_artemis($file));
    do {
      my @data = &every_data;
      my $this = $paths{$current}->data;
      if ($#data or $paths{$this}->get('file')) {
	my $message = "Do you wish to read in a new data file (that is, to do multiple data set fitting), or do you wish to change the current data file (that is, to apply this fitting model to a different data set) ?";
	my $dialog =
	  $top -> Dialog(-bitmap         => 'questhead',
			 -text           => $message,
			 -title          => 'Athena: Reading data',
			 -buttons        => [qw/Change New Cancel/],
			 -default_button => 'Change',
			 -font           => $config{fonts}{med},
			 -popover        => 'cursor');
	&posted_Dialog;
	Echo("Not reading data"), my $response = $dialog->Show();
	return if ($response eq 'Cancel');
	my $change = ($response eq 'Change') ? $this : 0;
	($change) ? Echo("Changing data") : Echo("Importing new data");
	read_data($change, $file);
      } else {
	read_data(0, $file);
      };
    };
  };
  ## make sure something is to be plotted after the fit
  my @all = &all_data;
  foreach (@all) {
    return if $paths{$_}->get('plot');
  };
  $paths{$all[0]}->make(plot=>1);
};

## This dispatcher handles all the possibilities for different avenues
## of reading in files and decided whether it should be a new data set
## in an MDS fit or if it should be a change of data in the current
## data set.
sub dispatch_read_data {
  my ($change, $file, $from_project) = @_;
  ##&read_data(@_), return unless ($config{general}{read_data_query});

  track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
  my @data = &every_data;
  my $this_data = $paths{$current}->data;
  &read_data, return unless ($#data or $paths{$this_data}->get('file'));

  ## test to see if this is a zip-style project
  if ($file) {
    Archive::Zip::setErrorHandler( \&is_zip_error_handler );
    my $zip = Archive::Zip->new();
    my $is_zipstyle = ($zip->read($file) == AZ_OK);
    undef $zip;
    Archive::Zip::setErrorHandler( undef );
    &read_data($paths{$current}->data, $file), return if $is_zipstyle;
  };

  ##if (($change) and ($change ne "1") and ($change !~ /Tk::Tree/) and (not $from_project)) {
  if ($#data or $paths{$this_data}->get('file')) {
    my $message = "Do you wish to read in a new data file (that is, to do multiple data set fitting), or do you wish to change the current data file (that is, to apply this fitting model to a different data set) ?";
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => $message,
		     -title          => 'Athena: Reading data',
		     -buttons        => [qw/Change New Cancel/],
		     -default_button => 'Change',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    Echo("Not reading data"), return if ($response eq 'Cancel');
    if ($response eq 'Change') {
      Echo("Changing data");
      ## this is needed to handle an mru file
      if ($file) {
	&read_data($paths{$current}->data, $file);
      } elsif ($from_project) {
	&read_data($paths{$current}->data, $file, 1);
      } else {
	&renew_data;
      };
    } else {
      Echo("Importing new data.");
      &read_data(@_);
    };
  } else {
    &renew_data;
  };
};

sub renew_data {
  #track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
  &read_data($paths{$current}->data);
};

## 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; };

sub read_data {
  my $change = $_[0];
  my $file   = $_[1];
  my $from_project = $_[2] || 0;
  my $force_chi = $_[3] || 0;
  ((defined $change) and ($change =~ /data\d+/)) or ($change = 0);
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;
  my $path = $current_data_dir || cwd;
  $path = File::Spec->catfile($project_folder, "chi_data", "") if $from_project;
  ##print ">>> --$from_project--    --$current_data_dir--   --$path--\n";
  my $types = [['Athena projects, chi(k) data, or Artemis projects', ['*.prj', '*.chi', '*.apj']],
	       ['Athena projects',  '*.prj'],
	       ['chi(k) data',      '*.chi'],
	       ['Artemis projects', '*.apj'],
	       ['All files',        '*'],];
  if ($from_project) {
    @$types[0,1,2] = @$types[2,0,1];
  } elsif ($change) {
    @$types[0,1] = @$types[1,0];
  };
  $file ||= $top -> getOpenFile(-filetypes=>$types,
				##(not $is_windows) ?
				##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-title => "Artemis: Open a data file");
  return unless ($file);
  Error("$file does not exist!"), return unless (-e $file);

  track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
  ## test to see if this is a zip-style project
  Archive::Zip::setErrorHandler( \&is_zip_error_handler );
  my $zip = Archive::Zip->new();
  my $is_zipstyle = ($zip->read($file) == AZ_OK);
  undef $zip;
  Archive::Zip::setErrorHandler( undef );
  ##Archive::Zip::setErrorHandler( \&Carp::carp );

  my $stash = $file;

  unless ($is_zipstyle) {
    track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
    my $was_mac = $paths{gsd} ->
      fix_mac($file, $stash_dir, lc($config{general}{mac_eol}), $top);
    track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;
    return, Echo("\"$file\" had Macintosh EOL characters and was skipped.") if ($was_mac eq "-1");
    if ($was_mac) {
      Echo("\"$file\" had Macintosh EOL characters and was fixed.");
      $stash = $was_mac;
    };
  };

  ## 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 $file will be the same
  ##   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;
  ##   };

  ## this is a zip-style project
  if ($is_zipstyle) {
    #$project_folder =
##     my $made_by = determine_version_from_project($file);
    $top -> Busy;
    my $is_error = unpack_zip($file); ## pass reference to zip object??
    $top->Unbusy, return 0 if $is_error;
    $project_name = $file;
    ##@-fp-@     my $fp_exists = (-e File::Spec->catfile($project_folder, "descriptions", "...fp"));
    ##@-fp-@     if ($fp_exists) {
    ##@-fp-@       my $is_ok = compare_fingerprint(File::Spec->catfile($project_folder, "descriptions", "...fp"),
    ##@-fp-@ 				      File::Spec->catfile($project_folder, "descriptions", "artemis"));
    ##@-fp-@       unless ($is_ok) {
    ##@-fp-@ 	my $dialog =
    ##@-fp-@ 	  $top -> Dialog(-bitmap         => 'warning',
    ##@-fp-@ 			 -text           => "The fingerprint of the description file has changed.  This could indicate that this project file has been tampered with.  It may be unsafe to continue reading this project file.",
    ##@-fp-@ 			 -title          => 'Artemis: Possibly tainted project file...',
    ##@-fp-@ 			 -buttons        => [qw/Continue Abort/],
    ##@-fp-@ 			 -default_button => 'Abort',
    ##@-fp-@		     -popover        => 'cursor');
    ##@-fp-@ 	&posted_Dialog;
    ##@-fp-@ 	my $response = $dialog->Show();
    ##@-fp-@ 	if ($response eq 'Abort') {
    ##@-fp-@ 	  delete_project(0);
    ##@-fp-@ 	  return;
    ##@-fp-@ 	};
    ##@-fp-@       };
    ##@-fp-@     };
    open_project(File::Spec->catfile($project_folder, "descriptions", "artemis"));
    set_fit_button('fit');
    $top->Unbusy;
    return;
  ## test to see if this is an old-style project
  } elsif (is_old_project($stash)) {
    $project_name = $stash;
    my $retval = convert_project_to_zip($stash);
    return 0 unless $retval;
    #$project_folder =
    my $is_error = unpack_zip($stash);
    return 0 if $is_error;
    open_project(File::Spec->catfile($project_folder, "descriptions", "artemis"));
    set_fit_button('fit');
    return;
  };

  ## or if it is a record from athena
  if (Ifeffit::Files->is_record($stash)) {
    Echo("Reading $file as an Athena project");
    read_athena($stash);
    return;
  };

  ## make sure this is interpretable as data
  $paths{data0} -> dispose("read_data(file=\"$file\", group=t___oss, no_sort)\n", $dmode);
  unless (Ifeffit::Files->is_datafile) {
    &posted_Dialog;
    $top -> Dialog(-bitmap  => 'error',
		   -text    => "\`$file\' could not be read by ifeffit as a data file",
		   -title   => 'Artemis: Error reading file',
		   -buttons => ['OK'],
		   -default_button => "OK",
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor' )
      -> Show();
    Echo("Failed to read \"$file\" as data");
    $paths{data0} -> dispose("erase \@group t___oss", $dmode);
    set_status(0);
    $top->Unbusy, return 0;
  };
  my $suff = (split(" ", Ifeffit::get_string('$column_label')))[0];
  $paths{data0} -> dispose("set ___n = npts(t___oss.$suff)", $dmode);
  my $nn = Ifeffit::get_scalar("___n");
  unless ($nn > 10) {
    &posted_Dialog;
    $top -> Dialog(-bitmap  => 'error',
		   -text    => "\`$file\' has fewer than 10 data points.",
		   -title   => 'Artemis: Error reading file',
		   -buttons => ['OK'],
		   -default_button => "OK",
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor' )
      -> Show();
    Echo("Failed to read \"$file\" as data");
    $paths{data0} -> dispose("erase \@group t___oss", $dmode);
    set_status(0);
    $top->Unbusy, return 0;
  };
  $paths{data0} -> dispose("erase \@group t___oss", $dmode);
  set_status(0);

  ## if we have multicolumn data, then we need to have the user choose
  ## the correct column, this column will be written to a data file in
  ## the chi_data directory of the project space

  ## -1=tagged by Athena 0=two column  else &n_arrays_read from Ifeffit
  my $is_multicolumn = (Ifeffit::Files->is_multicolumn($file) and (not $force_chi));
  my $bail = 0;
  if ($is_multicolumn) {
    Echo("$file is a multicolumn data file");
    my $cols = $top -> Toplevel(-title=>"Artemis: multicolumn file ($file)",
				-class=>'horae');
    $cols -> protocol(WM_DELETE_WINDOW => sub{$bail = 1;
					      $cols->grabRelease;
					      $cols->destroy;});
    $cols -> bind('<Control-q>' => sub{$bail = 1;
				       $cols->grabRelease;
				       $cols->destroy;});
    $cols -> iconimage($iconimage);
    $cols -> grab;
    my $left = $cols -> Frame()
      -> pack(-side=>'left',  -fill=>'y', -expand=>1);
    my $right = $cols -> Frame()
      -> pack(-side=>'right', -fill=>'both', -expand=>1);

    my $databox = $right -> Scrolled('ROText', -scrollbars=>'se', -width=>50,
				     -relief=>'sunken', -borderwidth=>2,
				     -wrap=>'none')
      -> pack(-fill=>'both', -expand=>1);
    BindMouseWheel($databox);
    $databox->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
    $databox->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
    do {
      local $/ = undef;
      open F, $file;
      $databox->insert('1.0', <F>);
      close F;
    };

    $left -> Label(-text=>"Select a chi(k) column",
		   @title2)
      -> pack(-side=>'top', -pady=>5);

    $paths{gsd} -> dispose("read_data(file=$file, group=t___oss)\n", 1);
    my @cols = split(" ", Ifeffit::get_string('$column_label'));
    my ($wn, $chi) = (@cols[0..1]);
    my $i = 0;
    my $top = $left -> Frame(-relief=>'groove', -borderwidth=>2)
      -> pack(-side=>'top', -anchor=>'n', -padx=>4, -pady=>4, -pady=>2);
    $top -> Label(-text=>'wavenumber', -foreground=>$config{colors}{activehighlightcolor})
      -> grid(-column=>1, -row=>0, -padx=>4, -pady=>2);
    $top -> Label(-text=>'chi(k)', -foreground=>$config{colors}{activehighlightcolor})
      -> grid(-column=>2, -row=>0, -pady=>2);
    foreach my $c (@cols) {
      ++$i;
      my $j = $i;
      $top -> Label(-text=>$c, -foreground=>$config{colors}{activehighlightcolor})
	-> grid(-column=>0, -row=>$i, -sticky=>'e', -pady=>2);
      $top -> Radiobutton(-text=>"", -value=>$c, -variable=>\$wn,
			  -command=>sub{($chi = ($j==5) ? $cols[0] : $cols[$j]) if ($wn eq $chi);
					my $command = "newplot(x=t___oss.$wn, y=t___oss.$chi, ";
					$command   .= "title=\"current column selection\", xlabel=x, ylabel=y)\n";
					$paths{gsd}->dispose($command, $dmode);
				      })
	-> grid(-column=>1, -row=>$i, -pady=>2);
      $top -> Radiobutton(-text=>"", -value=>$c, -variable=>\$chi,
			  -command=>sub{($chi = ($j==5) ? $cols[0] : $cols[$j]) if ($wn eq $chi);
					my $command = "newplot(x=t___oss.$wn, y=t___oss.$chi, ";
					$command   .= "title=\"current column selection\", xlabel=x, ylabel=y)\n";
					$paths{gsd}->dispose($command, $dmode);
				      })
	-> grid(-column=>2, -row=>$i, -pady=>2);
    };

    my $bottom = $left -> Frame()
      -> pack(-side=>'bottom', -fill=>'x', -expand=>1);
    my $ok = $left -> Button(-text=>'OK', @button2_list,
			     -command=>sub{$cols->grabRelease;
					   $cols->destroy})
      -> pack(-side=>'left', -fill=>'x', -expand=>1);
    $left -> Button(-text=>'Cancel', @button2_list,
		    -command=>sub{$bail=1;
				  $cols->grabRelease;
				  $cols->destroy})
      -> pack(-side=>'right', -fill=>'x', -expand=>1);
    my $command = "newplot(x=t___oss.$wn, y=t___oss.$chi, ";
    $command   .= "title=\"current column selection\", xlabel=x, ylabel=y)\n";
    $paths{gsd}->dispose($command, $dmode);
    $ok -> focus;
    $cols -> waitWindow;

    unless ($bail) {
      ## transfer this column to its own data file in the project data folder
      my $fname = File::Spec->catfile($project_folder, "chi_data", "$chi.chi");
      my ($count, $chi_orig) = (1, $chi);
      while (-e $fname) {
	$chi = $chi_orig . "_$count";
	++$count;
	$fname = File::Spec->catfile($project_folder, "chi_data", "$chi.chi");
      };
      $paths{gsd} -> dispose("set \$t___oss_title_01 = \"Artemis extracted data file -- Artemis version $VERSION\"\n", $dmode);
      $paths{gsd} -> dispose("write_data(file=$fname, \$t___oss_title_*, label=\"k chi\", t___oss.$wn, t___oss.$chi_orig)", $dmode);
      $paths{gsd} -> dispose("erase \@group t___oss\n", 1);
      &push_mru($file, 1, "data") unless $from_project;
      $stash = $fname;
      my $new = File::Spec->catfile($project_folder, "chi_data", basename($file));
      copy($file, $new) unless ($file eq $new);
      $from_project = 1;
    };
  };
  Echo("Aborting read of multicolumn data file $file."), return if $bail;

  ## nope... this is a data file.  import this data file into the project

  my $name = ($from_project) ? basename($file) : &push_mru($file, 1, "data");
  $name = basename($stash) if $is_multicolumn;
  #my ($name, $pth, $suffix) = fileparse($file);
  #$current_data_dir = $pth;

  ## make a place to put the data
  my $project_data_dir = File::Spec->catfile($project_folder, "chi_data");
  my $nme = basename($stash);
  my $bn  = basename($stash, qw(.chi));
  my $new = File::Spec->catfile($project_data_dir, $nme);
  ##($new = File::Spec->catfile($stash_dir, "toss")) if (length($new) > 127);
  my $count = 1;
  unless ($stash eq $new) {
    while (-e $new) {		# care not to overwrite files
      $new = File::Spec->catfile($project_data_dir, $bn."_$count.chi");
      ++$count;
    };
  };
  copy($stash, $new) unless ($stash eq $new);
  $stash = $new;

  my $label = unique_label($name);

  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'normal')} (keys %widgets);
  map {$grab{$_}->configure(-state=>'normal')} (keys %grab);
  my $next = &next_data;
  my $group = $change || 'data' . $next;
  if ($change) {
    ## read the new data into ifeffit's memory
    my $command = "## Renewing data file:\n";
    #if ($stash ne $file) {
    #  $command .= "## actual file: $file\n";
    #  $command .= "## transfered to stash file: $stash\n";
    #};
    $command   .= "read_data(file=\"$stash\", type=chi, group=ch___eck)\n\n";
    $paths{$group} -> dispose($command, $dmode);
    Error("$file doesn't appear to be a data file"), return unless (&is_datafile);
    $command = "erase \@group ch___eck\n";
    $command   .= "read_data(file=\"$stash\", type=chi, group=$group)\n\n";
    ## delete the old title lines from Ifeffit's memory
    my ($i, $titles) = (1, "");
    my $string = join("", "\$", $group, "_title_", sprintf("%2.2d",$i));
    my $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    while ($str !~ /^\s*$/) {
      $string = join("", "\$", $group, "_title_", sprintf("%2.2d",$i));
      $paths{$group} -> dispose("$string = \"\"", $dmode);
      ++$i;
      $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    };
    $paths{$group} -> dispose($command, $dmode);
    ## put the new item in the path list
    #$name = (split(/\./, $name))[0];
    $paths{$group} -> make(file=>$stash, original_file=>$file,
			   lab=>$label, is_rec=>0,
			   with_bkg=>0, with_fit=>0, with_res=>0);
    ##$list -> hide('entry', $paths{$group}->get('id').".0");
    ##$list -> hide('entry', $paths{$group}->get('id').".1");
    ##$list -> hide('entry', $paths{$group}->get('id').".2");

    $list -> entryconfigure($paths{$group}->get('id'), -text=>$label);
    if (not &uniform_k_grid($group)) {
      #$paths{$group} -> make(fix_chi => 1);
      $paths{$group} -> dispose("## this seems to be chi(k) data in need of fixing...\nfix_chik($group)",
				$dmode);
      my $command = "\$artemis_title1 = \"Artemis output file, path -- Artemis version $VERSION\"\n";
      $command   .= "\$artemis_title2 = \"Data interpolated onto even grid \"\n";
      $command   .= "write_data(file=$stash,\n";
      $command   .= wrap("           ", "           ", "\$artemis_title*, \$${group}_title_*, $group.k, $group.chi)");
      $paths{$group} -> dispose($command, $dmode);
    };

    ## load up the new titles
    $i = 1;
    $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    while ($str !~ /^\s*$/) {
      $titles .= $str."\n";
      ++$i;
      $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    };
    $paths{$group} -> make(titles=>$titles);
    ## and display the new titles
    $widgets{op_titles} -> delete(qw(1.0 end));
    $widgets{op_titles} -> insert('end', $titles);
  } else {
    $paths{gsd} -> dispose("## Reading data file: \n", $dmode);
    #if ($stash ne $file) {
    #  $paths{gsd} -> dispose("## actual file: $file\n", $dmode);
    #  $paths{gsd} -> dispose("## transfered to stash file: $stash\n", $dmode);
    #};
    $paths{gsd} -> dispose("read_data(file=\"$stash\", type=chi, group=$group)\n\n", $dmode);
    Error("$file doesn't appear to be a data file"), return unless (&is_datafile);
    my $fit   = $group . '.0';
    #$name = (split(/\./, $name))[0];

    ## handle the list entry for this data set
    if ($next > 0) {
      $paths{$group} = Ifeffit::Path -> new(id		  => $group,
					    group	  => $group,
					    type	  => 'data',
					    sameas	  => 0,
					    file	  => $stash,
					    lab		  => $label,
					    original_file => $file,
					    family	  => \%paths);
      $list -> add($group, -text=>$label, -style=>$list_styles{enabled});
      $list -> setmode($group, 'none');

      $list -> add($group.".0", -text=>'Fit', -style=>$list_styles{enabled},);
      $list -> setmode($group.'.0', 'none');
      $list -> hide('entry', $group.".0");
    } else {			# this is the first data set
      $list -> entryconfigure($paths{$group}->get('id'), -text=>$label);
    };

    ## and set all the default values
    $paths{$group} -> make(group=>$group, file=>$stash, lab=>$label,
			   original_file=>$file,
			   fit_space => $config{data}{fit_space},
			   do_bkg    => ($config{data}{fit_bkg}) ? 'yes' : 'no',
			   kmin      => $config{data}{kmin},
			   kmax      => $config{data}{kmax},
			   dk        => $config{data}{dk},
			   k1        => ($config{data}{kweight} == 1),
			   k2        => ($config{data}{kweight} == 2),
			   k3        => ($config{data}{kweight} == 3),
			   rmin      => $config{data}{rmin},
			   rmax      => $config{data}{rmax},
			   dr        => $config{data}{dr},
			   kwindow   => $config{data}{kwindow},
			   rwindow   => $config{data}{rwindow},
			   cormin    => $config{data}{cormin},
			  );

    # interpret the range parameters
    if ($paths{$group}->get('kmax') == 0) {
      $paths{$group}->make(kmax=>15);
      my ($epsk, $epsr, $suggest) = $paths{$group}->chi_noise;
      $suggest ||= 15;
      $paths{$group}->make(kmax=>$suggest);
    };
    $paths{$group} -> fix_values();

    ## the or-eq is necessary for the situation where an ff2chi was
    ## done before the data was read in
    $paths{$fit}   ||=  Ifeffit::Path -> new(id     => $group.".0",
					     type   => 'fit',
					     group  => $group."_fit",
					     sameas => $group,
					     lab    => 'Fit',
					     parent => 0,
					     family => \%paths);
    if (not &uniform_k_grid($group)) {
      #$paths{$group} -> make(fix_chi => 1);
      $paths{$group} -> dispose("## this seems to be chi(k) data in need of fixing...\nfix_chik($group)",
				$dmode);
      my $command = "\$artemis_title1 = \"Artemis output file, path -- Artemis version $VERSION\"\n";
      $command   .= "\$artemis_title2 = \"Data interpolated onto even grid \"\n";
      $command   .= "write_data(file=$stash,\n";
      $command   .= wrap("           ", "           ", "\$artemis_title*, \$${group}_title_*, $group.k, $group.chi)");
      $paths{$group} -> dispose($command, $dmode);
    };
    ## other possible: eps_r toler do_real do_ph do_mag
    my ($i, $titles) = (1, "");
    my $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    while ($str !~ /^\s*$/) {
      $titles .= $str."\n";
      ++$i;
      $str = Ifeffit::get_string(join("", "\$", $group, "_title_", sprintf("%2.2d",$i)));
    };
    $paths{$group} -> make(titles=>$titles);
    $widgets{op_titles} -> insert('end', $paths{$group}->get('titles')) if
      (($group eq 'data0') and ($widgets{op_titles}->get(qw(1.0 end)) =~ /^\s*$/));

  };
  $props{'Project title'} = "Fitting ".$paths{$group}->descriptor
    if $props{'Project title'} =~ /^(\<|$)/;
  &set_fit_button('fit');

  ## save an autosave file...
  &save_project(0,1);

  ++$n_data;
  display_page($group);
  $file_menu->menu->entryconfigure($save_index, -state=>'normal'); # enable save data
  $file_menu->menu->entryconfigure($save_index+6, -state=>'normal');
  plot('r', 0);
  if ($is_multicolumn) {
    Echo("Read column $name from $file");
  } else {
    Echo("Read data from $file");
  };
  $top -> update();
  project_state(0);
  return $group;
};


## this should be called immediately after a disposal of
## "read_data". It checks the $column_label ifeffit global variable,
## which ifeffit sets to "--undefined--" when it is thinks that it was
## given a file that was not actually data.
sub is_datafile {
  my $col_string = Ifeffit::get_string('$column_label');
  return (not ($col_string =~ /^--undefined--$/));
};

sub determine_version_from_project {
  my $zipfile = $_[0];
  Archive::Zip::setErrorHandler( \&is_zip_error_handler );
  my $zip = Archive::Zip->new();
  die 'error reading project file $zipfile' unless $zip->read($zipfile) == AZ_OK;
  my $tmp = $paths{data0} -> find('artemis', 'tmp');
  $zip -> extractMember("descriptions/artemis", $tmp);
  open T, $tmp;
  my $line = <T>;
  chomp $line;
  close T;
  unlink $tmp;
  my $vnum = $1 if ($line =~ /version (.+)$/);
  undef $zip;
  Archive::Zip::setErrorHandler( undef );
  ($vnum = "DR" . $1) if ($vnum =~ /Development Branch Release (\d+)/);
  Echo("This project is from Artemis version $vnum");
  return $vnum;
};


## check to see that input chi(k) data is on a rigorously uniform
## k-grid. also check that the first point is either 0 or 0.05.
## return 0 if this data fails either test.
sub uniform_k_grid {
  my ($group) = @_;
  my @x = Ifeffit::get_array("$group.k");
  return 0 unless ((abs($x[0]) < EPSILON) or ($x[0]-0.05 < EPSILON));
  my $ok = 1;
  my $prev = sprintf "%.3f", $x[1] - $x[0];
  foreach (2 .. $#x) {
    my $this = sprintf "%.3f", $x[$_] - $x[$_-1];
    $ok = (
	   ($this eq $prev)
	   and
	   (abs($this-0.05) < EPSILON)
	  )
      ? 1 : 0;
    $prev = $this;
    return 0 if not $ok;
  };
  return $ok;
};


sub read_feff {
  my $file = ($_[0] =~ /^\^\^/) ? "" : $_[0];
  my $nopaths = $_[1];
  unless ($file) {
    ##local $Tk::FBox::a;
    ##local $Tk::FBox::b;
    my $path = $current_data_dir || cwd;
    if (($_[0] =~ /^\^\^/) and ($paths{$current}->get('type') =~ /(feff|path)/)) {
      $path = $paths{$current}->get('path');
    };
    ## apparently some windows apps will save a text file with a
    ## Capitalized File Name...
    my $types;
    if ($_[0]) {			# add a path
      $types = [['feffNNNN.dat and input files', [ 'feff*.dat', '*.inp', '*.INP', '*.Inp']],
		['FEFF input files', ['feff.inp', 'FEFF.INP', 'Feff.Inp', 'Feff.inp']],
		['feffNNNN.dat files', ['feff*.dat', 'FEFF*.DAT', 'Feff*.Dat', 'Feff*.dat']],
		['input files', ['*.inp', '*.INP', '*.Inp']],
		['All Files', '*'],];
    } else {			# read feff
      $types = [['FEFF input files', ['feff.inp', 'FEFF.INP', 'Feff.Inp', 'Feff.inp']],
		#['feffNNNN.dat files', ['feff*.dat', 'FEFF*.DAT', 'Feff*.Dat', 'Feff*.dat']],
		['input files', ['*.inp', '*.INP', '*.Inp']],
		#['feffNNNN.dat and input files', [ 'feff*.dat', 'FEFF.INP', 'Feff.Inp', 'Feff.inp', '*.inp', '*.INP', '*.Inp']],
		['All Files', '*'],];
    };
    $file = $top -> getOpenFile(-filetypes=>$types,
				##(not $is_windows) ?
				##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-title => "Artemis: Import a Feff calculation");
    return unless ($file);
  };
  Echo("Could not find \"$file\""), return unless (-e $file);
  my ($name, $feff_path, $suffix) = fileparse($file);
  $current_data_dir = $feff_path;
  track({file=>$file, mode=>"reading from", command=>sub{my $size = -s $file; print "size : $size\n"}}) if $debug_file_path;

  my $data = $paths{$current}->data;
  ## assign an id to this feff calc
  my $id = $data . '.feff' . $n_feff;

  ## import this feff calc into the project by copying all files
  ## &initialize_project(0);
  my $project_feff_dir = &initialize_feff($id);
  ## copy all these feff files to the project feff folder
  opendir F, $feff_path;
  my @list = grep { (-f File::Spec->catfile($feff_path,$_)) and
		    (lc($_) =~ /\.(bin|dat|inp|log|run)$/) } readdir F;
  closedir F;
  map { copy(File::Spec->catfile($feff_path,$_), $project_feff_dir) } @list;

  ## make sure that the feff.inp file is "feff.inp"
  copy($file, File::Spec->catfile($project_feff_dir, 'feff.inp'));

  my $exists = '';
  my @nnnnlist;
  ## windows has an intensely stoopid setting where file extensions
  ## are not displayed in the file selection widget.  in that case it
  ## is difficult to distinguish between feff.inp and feff.bin (a
  ## feff8 file option).  this next line does something reasonable
  ## when feff.bin is selected.
  $name =~ s/\.bin$/\.inp/;

  if (lc($name) =~ /inp$/) {
    ## artemis wants the feff input file to be called feff.inp,
    ## regardless of what filename the user clicked on
    copy($file, File::Spec->catfile($project_feff_dir, 'feff.inp'));
    ## don't push to the MRU if this feff.inp comes from the tmp directory
    my $tmpdir = File::Spec->catfile($project_folder, "tmp");
    my $thisdir = dirname($file);
    push_mru($file, 1, 'feff') unless same_directory($tmpdir, $thisdir);
  } else {
    ## this is a feffNNNN.dat file, not a feff.inp file, figure out
    ## which feff calc it's a part of
    push @nnnnlist, $name;
    foreach my $k (keys %paths) {
      next unless (ref($paths{$k}) =~ /Ifeffit/);
      next unless ($paths{$k}->type eq 'feff');
      next unless same_directory($paths{$k}->{path}, $feff_path);
      $exists = $k;
      $id = $paths{$k}->get('id');
      last;
    };
  };

  unless ($exists) {
    ## instantiate a new object
    $paths{$id} = Ifeffit::Path -> new(id     => $id,
				       type   => 'feff',
				       path   => $project_feff_dir,
				       data   => $data,
				       lab    => 'FEFF'.$n_feff,
				       mode   => 2,
				       family => \%paths,
				       atoms_atoms => []);
    my @autoparams;
    $#autoparams = 6;
    (@autoparams = autoparams_define($id, $n_feff, 0, 0)) if $config{autoparams}{do_autoparams};
    $paths{$id} -> make(autoparams=>[@autoparams]);

    if (lc($name) =~ /inp$/) {

      opendir D, $project_feff_dir or die "cannot read directory $project_feff_dir\n";
      @nnnnlist = sort grep /feff\d{4}\.dat/i, readdir D;
      closedir D;
      if (@nnnnlist) {
	my $response;
	if ($nopaths) {
	  $response = "No paths";
	} else {
	  my $dialog =
	    $top -> Dialog(-bitmap         => 'questhead',
			   -text           => "How many feff paths do you want to import right now.",
			   -title          => 'Artemis: Question...',
			   -buttons        => ['No paths',
					       'Just the first',
					       "The first $config{paths}{firstn}",
					       'All paths'],
			   -default_button => 'All paths',
			   -font           => $config{fonts}{med},
			   -popover        => 'cursor');
	  &posted_Dialog;
	  $response = $dialog->Show();
	};
	$paths{$id} -> make("feff.inp" => File::Spec->catfile($project_feff_dir, $name));
	## fetch list of feffNNNN.dat files
	Echo("Importing " . lc($response));
	($#nnnnlist = -1) if ($response eq 'No paths');
	($#nnnnlist = 0)  if ($response eq 'Just the first');
	($#nnnnlist = $config{paths}{firstn}-1) if (($response =~ /^The first/) and
						    ($#nnnnlist > $config{paths}{firstn}-1));
      } else {
	## this is the situation of importing a feff.inp that has not
	## been run to produce the feffNNNN.dat files
	$exists = 1;
	## setting this variable flags the incrementing of $n_feff 7
	## lines below and precludes a few other actions later in this
	## sub
      };
    };
    $list -> add($id, -text=>'FEFF'.$n_feff, -style=>$list_styles{noplot});
    $list -> setmode($id, 'close');
    $list -> setmode($paths{$data}->get('id'), 'close')
      if ($list -> getmode($paths{$data}->get('id')) eq 'none');
    ++$n_feff if $exists;
  };

  ## do intrp
  unless ($exists) {
    my $intrp_ok = &do_intrp($id);
    $paths{$id} -> make(mode=>$paths{$id}->get('mode')+4);
  };


  $list->selectionClear;
  if ($exists and ($exists =~ /^1$/)) {
    display_page($id);
  } elsif ($exists) {
    display_page($exists);
  } else {
    display_page($id);
  };
  $exists or ++$n_feff;
  $file_menu -> menu -> entryconfigure($save_index+6, -state=>'normal');
  $file_menu -> menu -> entryconfigure($save_index+4, -state=>($Tk::VERSION > 804) ? 'normal' : 'disabled'); # all paths

  my $i = 0;
  foreach my $f (sort {lc($a) cmp lc($b)} (@nnnnlist)) {
    #my $kid = $list -> addchild($id);
    (!$i) or ($i % 10) or Echo("Reading the ${i}th feffNNNN.dat file");
    #fetch_nnnn($project_feff_dir, $f, join('.', $id, $i), $f);
    my $kid = fetch_nnnn($id, $project_feff_dir, $f);
    $exists = $kid if $exists;
    $list -> entryconfigure($kid,
			    -style => $list_styles{$paths{$kid}->pathstate("enabled")},
			    -text  => $paths{$kid}->get('lab'));
    ++$i;
  };


  ## set display and increment feff counter
  &set_fit_button('fit');

  ## save an autosave file...
  &save_project(0,1);

  project_state(0);
  return $id;
};


sub save_all_paths {
  my $space = $_[0];
  my $suff;
 SW: {
    $suff = '.chi', last SW if (lc($space) eq 'k');
    $suff = '.rsp', last SW if (lc($space) eq 'r');
    $suff = '.qsp', last SW if (lc($space) eq 'q');
  };
  my $dir = $top -> chooseDirectory(-initialdir	=> $current_data_dir,
				    -title	=> "Artemis: Select a directory",
				    #-mustexist	=> 1,
				   );
  Error("Saving all paths -- aborted.  You did not select a directory."), return 0 unless $dir;
  $current_data_dir = $dir;
  Echo("Saving all included paths to files ...");
  $top -> Busy;
  ## refresh the variables and title glob  before writing out the paths
  my $command = "\n## saving all included paths to files\n";
  ##$command .= &erase_all_variables;
  ##&read_gds2(1);		# update gsd object
  if ($parameters_changed) {
    map { $command .= $_ -> write_gsd } (@gds);
    $parameters_changed = 0;
  };
  my $titles = $widgets{op_titles}->get(qw(1.0 end));
  my $n = 3;
  foreach my $t (split(/\n/,$titles)) {
    next if ($t =~ /^\s*$/);
    $command .= "\$artemis_title$n = \"$t\"\n";
    ++$n;
  };
  $paths{$current} -> dispose($command, $dmode);

  my $this_data = $paths{$current}->data;
  my $kw = $plot_features{kweight};
  ($kw = $paths{$this_data}->default_k_weight) if ($kw eq 'kw');

  foreach my $k (&path_list) {
    next unless ($k =~ /feff\d+\.(\d+)/);
    next unless $paths{$k}->get('include');

    my $command = "";
    my $group = Ifeffit::Path::pathgroup($k, \%paths);

    my $ii = $paths{$k}->index;
    ## my $parent = $paths{$k}->get('parent');
    my $pathto = $paths{$k}->get('path');
    $command .= $paths{$k} -> write_path($ii, $pathto, $config{paths}{extpp}, $stash_dir);
    $command .= "ff2chi($ii, group=$group)\n";

    $command .= "\$artemis_title1 = \"Artemis output file, path -- Artemis version $VERSION\"\n";
    $command .= "\$artemis_title2 = \"Path data from " . $paths{$k}->descriptor() . "\"\n";
    $command .= "\$artemis_title$n = \"artemis: $group in $space space\"\n";

    my $data = $paths{$k}->data;
    my $name = $paths{$k}->descriptor();
    $name =~ s/[.:@&\/\\ ]/_/g;
    my $file = File::Spec->catfile($current_data_dir, $name.$suff);
  SWITCH: {
      (lc($space) eq 'k') and do {
	$command .= "write_data(file=$file,\n" .
	  wrap("           ", "           ", "\$artemis_title*, $group.k, $group.chi)");
	last SWITCH;
      };
      (lc($space) eq 'r') and do {
	#($paths{$k}->get('do_r')) and
	$command .= $paths{$k} -> write_fft($kw, $config{data}{rmax_out});
	$command .= "write_data(file=$file,\n" .
	  wrap("           ", "           ",
	       "\$artemis_title*, $group.r, $group.chir_re, " .
	       "$group.chir_im, $group.chir_mag, $group.chir_pha)");
	last SWITCH;
      };
      (lc($space) eq 'q') and do {
	#($paths{$k}->get('do_r')) and
	#($paths{$k}->get('do_q')) and
	$command .= $paths{$k} -> write_fft($kw, $config{data}{rmax_out});
	$command .= $paths{$k} -> write_bft();
	$command .= "write_data(file=$file,\n" .
	  wrap("           ", "           ",
	       "\$artemis_title*, $group.q, $group.chiq_re, " .
	       "$group.chiq_im, $group.chiq_mag, $group.chiq_pha)");
	last SWITCH;
      };
    }; # end of SWITCH
    $paths{$k} -> dispose($command, $dmode);
  }; # end of loop over paths
  $top -> Unbusy;
  Echo("Saved all paths in $space space to $current_data_dir");
};

## check to see if fit and bkg exist...
sub save_data {
  my ($which, $space, $dont_ask) = @_;
  Echo("Want to save $which in $space space");
  my $command = "";
  ## get the correct group name
  my ($group, $lab);
  my $save = $current;
  if (($which eq 'path') and ($current_canvas ne 'path')) {
    Error("A path is not currently displayed.");
    return;
  };
  if ($which eq 'path') {	# prep a path for writing
    ## what about multiple feff calcs and indeces
    $group = Ifeffit::Path::pathgroup($current, \%paths);
    if ($current =~ /feff\d\.(\d+)/) {
      my $ii = $paths{$current}->index;
      my $pathto = $paths{$current}->get('path');
      ##$command .= &erase_all_variables;
      ##&read_gds2(1);			# update gsd object
      if ($parameters_changed) {
	map { $command .= $_ -> write_gsd } (@gds);
	$parameters_changed = 0;
      };
      $command .= $paths{$current} -> write_path($ii, $pathto, $config{paths}{extpp}, $stash_dir);
      $command .= "ff2chi($ii, group=$group)\n";
    };
  } else {			# prep data/fit/background for writing
    ## need to determine the data that corresponds to this feff|path|fit|bkg|res|diff
    $group = $paths{$current}->data;
    $lab   = $paths{$group}->get('lab');
    $lab   = (split(/\./, $lab))[0];
    $save  = $group;
    ($which eq 'fit')  and (($group, $lab, $save) =
			    ($group."_fit",  $lab."_fit",  $group.".0"));
    ##     ($which eq 'bkg')  and (($group, $lab, $save) =
    ## 			    ($group."_bkg",  $lab."_bkg",  $group.".2"));
    ##     ($which eq 'res')  and (($group, $lab, $save) =
    ## 			    ($group."_res",  $lab."_res",  $group.".1"));
  };

  ## get the output filename
  my $file;
  my $path = $current_data_dir || cwd;
  my ($desc, $suff);
 SW: {
    ($desc, $suff) = ('chi(k) files', '.chi'), last SW if (lc($space) eq 'k');
    ($desc, $suff) = ('chi(R) files', '.rsp'), last SW if (lc($space) eq 'r');
    ($desc, $suff) = ('chi(q) files', '.qsp'), last SW if (lc($space) eq 'q');
  };
  my $types = [[$desc, $suff], ['All Files', '*'],];
  my $init;
  if ($paths{$current}->type eq 'path'){
    my $name = $paths{$current}->descriptor();
    $name =~ s/[.:@&\/\\ ]/_/g;
    $init = $name.$suff;
  } else {
    $init = $group.$suff;
    ($init = $lab.$suff) if $lab;
  };
  ($init =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  $file = $top -> getSaveFile(-filetypes=>$types,
			      ##(not $is_windows) ?
			      ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
			      -initialfile=>$init,
			      -initialdir=>$path,
			      -title => "Artemis: Save data");
  return unless ($file);
  ## make sure I can write to $file
  open F, ">".$file or do {
    Error("You cannot write to \"$file\".  Check the permissions of that file."); return
  };
  close F;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  ## make the titles glob
  my $titles = $widgets{op_titles}->get(qw(1.0 end));
  $command .= "\$artemis_title1 = \"Artemis output file, data -- Artemis version $VERSION\"\n";
  my $n = 2;
  if ($which eq 'path') {
    $command .= "\$artemis_title$n = \"Path data from " . $paths{$current}->get('lab') . "\"\n";
    ++$n;
  };
  foreach my $l (split(/\n/, $paths{$current}->param_summary($plot_features{kweight}))) {
    $command .= "\$artemis_title$n = \"$l\"\n";
    ++$n;
  };

  foreach my $t (split(/\n/,$titles)) {
    next if ($t =~ /^\s*$/);
    $command .= "\$artemis_title$n = \"$t\"\n";
    ++$n;
  };
  $command .= "\$artemis_title$n = \"artemis: <".$paths{$save}->descriptor."> in $space space\"\n";


  ## build the write_data command
  my $kw = $plot_features{kweight};
  ($kw = $paths{$save}->default_k_weight) if ($kw eq 'kw');
 SWITCH: {
    (lc($space) eq 'k') and do {
      my $suff = "chi";
      ($paths{$save}->get('do_r')) and  do {
	my $data = $paths{$current}->data;
	my $kw = ($plot_features{kweight} eq 'kw') ? $paths{$data}->default_k_weight() : $plot_features{kweight};
	my $this = "$group.chi, k=$group.k, kweight=$kw, kmin=" . $paths{$data}->get('kmin') .
	    ", kmax=" . $paths{$data}->get('kmax') .
	      ", dk=" . $paths{$data}->get('dk') .
		", rmax_out=" . $config{data}{rmax_out} .
		  ", kwindow=" . $paths{$data}->get('kwindow') . ")";
	$command .= wrap('fftf(', '     ', $this) . "\n";
	$paths{$save} -> make(do_r=>0);
      };
      $command .= "write_data(file=$file,\n" .
	wrap("           ", "           ", "\$artemis_title*, $group.k, $group.$suff, $group.win)");
      last SWITCH;
    };
    (lc($space) eq 'r') and do {
      #($paths{$current}->get('do_r')) and (
      $command .= $paths{$save} -> write_fft($kw, $config{data}{rmax_out});
      $command .= $paths{$save} -> write_bft();
      $paths{$save} -> dispose("___x = ceil($group.chir_mag)", 1); # scale window to plot
      my $scale = $plot_features{window_multiplier} * Ifeffit::get_scalar("___x");
      $command .= "set $group.winout = $scale * $group.rwin\n";
      $command .= "write_data(file=$file,\n" .
	wrap("           ", "           ",
	     "\$artemis_title*, $group.r, $group.chir_re, " .
	     "$group.chir_im, $group.chir_mag, $group.chir_pha, $group.winout)");
      last SWITCH;
    };
    (lc($space) eq 'q') and do {
      $command .= $paths{$save} -> write_fft($kw, $config{data}{rmax_out});
      $command .= $paths{$save} -> write_bft();
      $command .= "write_data(file=$file,\n" .
	wrap("           ", "           ",
	     "\$artemis_title*, $group.q, $group.chiq_re, " .
	     "$group.chiq_im, $group.chiq_mag, $group.chiq_pha)");
      last SWITCH;
    };
  };
  $paths{$current} -> dispose($command, $dmode);
  Echo("Saved $which in $space space to $file");
};


sub save_selected {
  my $m = 0;
  foreach my $p ($list->info('selection')) {
    #my $pp = $p;
    #($pp = $1 . "_" . ("fit", "res", "bkg")[$2]) if ($p =~ /(data\d)\.(\d)/);
    next if ($paths{$p}->type =~ /(feff|gsd)/);
    ++$m
  };
  Error("Saving file aborted.  No plottable items are selected."), return 1 unless ($m);
  Error("You cannot save more than $limits{output_columns} groups to a single file.  Sorry."), return if ($m>$limits{output_columns});
  my $sp = $_[0];

  $top->Busy;

  my ($x, $y, $mess) = ('','','');
 SWITCH: {
    ($x, $y, $mess)=('k','chi', "chi(k)"),                           last SWITCH if ($sp eq 'k');
    ($x, $y, $mess)=('k','chi', "k weighted chi(k)"),                last SWITCH if ($sp eq 'k1');
    ($x, $y, $mess)=('k','chi', "k^2 weighted chi(k)"),              last SWITCH if ($sp eq 'k2');
    ($x, $y, $mess)=('k','chi', "k^3 weighted chi(k)"),              last SWITCH if ($sp eq 'k3');
    ($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', '*'],['Data Files', '*.dat']];
  my $path = $current_data_dir || Cwd::cwd;
  my $yy = $y;
  ($yy = "chi".$1) if ($sp =~ /k(\d)/);
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>"selected.".$yy,
				 -title => "Artemis: Save selected data");
  $top->Unbusy, return unless $file;
  ## make sure I can write to $file
  open F, ">".$file or do { Error("You cannot write to \"$file\".  Check the permissions of that file.");
			    $top -> Unbusy;
			    return };
  close F;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  Echo("Saving $mess for the selected data ...");

  $paths{$current} -> dispose("\n## saving selected data as columns in a file", $dmode);
  my @list = $list->info('selection');
  my $command = "file=$file, \$selected_title_\*, " . $paths{$list[0]}->get('group') . ".$x";
  my $precmd  = "";
  if ($parameters_changed) {
    map { $precmd .= $_ -> write_gsd(1) } (@gds);
    $parameters_changed = 0;
  };
  $paths{$current}->dispose("\$selected_title_1 = \"Artemis output file, selected -- Artemis version $VERSION\"", $dmode);
  $paths{$current}->dispose("\$selected_title_2 = \"This file contains $mess from:\"", $dmode);
  my $erase = "erase \$selected_title_1\nerase \$selected_title_2\n";
  my $ncol = 0;
  my $stan;
  my $kw = $plot_features{kweight};
  my $this_data = $paths{$current}->data;
  ($kw = $paths{$this_data}->default_k_weight) if ($kw eq 'kw');
  my @column_labels = ($x);
  foreach my $g (@list) {
    ##($g = $1 . "_" . ("fit", "res", "bkg")[$2]) if $g =~ /(data\d)\.(\d)/;
    next if ($paths{$g}->type =~ /(feff|gsd)/);
    my $group;
    my $this_label = $paths{$g}->descriptor();
    push @column_labels, $this_label; # use DPL labels as column labels
    if ($paths{$g}->type eq 'path') {
      my $ind    = $paths{$g} -> index;
      my $pathto = $paths{$g}->get('path');
      $precmd .= $paths{$g} -> write_path($ind, $pathto, $config{paths}{extpp}, $stash_dir);
      $group = Ifeffit::Path::pathgroup($g, \%paths);
      next unless $group;
      $precmd .= "ff2chi($ind, group=$group)\n";
    } elsif (($paths{$g}->{type} eq 'fit') and $paths{$g}->{parent}) {
      ## this is a fit, but not the parent of the fit branch
      unless ($paths{$g}->get('imported')) {
	## read this fit into its group if it has not already been imported
	$precmd .= "read_data(file=\"" .
	  $paths{$g}->get('fitfile') .
	    "\",\n" .
	      "          type=chi, group=". $paths{$g}->get('group') . ")\n";
	$paths{$g}->make(imported=>1);
      };
##       ## bkg plot has been requested
##       if (($do_bkg) and (-e $paths{$g}->get('bkgfile'))) {
## 	unless ($paths{$g}->get('imported_bkg')) {
## 	  (my $gr = $paths{$g}->get('group')) =~ s/fit/bkg/;
## 	  ## read this fit into its group if it has not already been imported
## 	  $precmd .= "read_data(file=\"" .
## 	    $paths{$g}->get('bkgfile') .
## 	      "\",\n          type=chi, group=$gr)\n";
## 	  $paths{$g}->make(imported_bkg=>1);
## 	};
##       };
##       ## residual plot has been requested
##       if ($do_res) {
## 	unless ($paths{$g}->get('imported_res')) {
## 	  (my $gr = $paths{$g}->get('group')) =~ s/fit/res/;
## 	  ## read this fit into its group if it has not already been imported
## 	  $precmd .= "read_data(file=\"" .
## 	    $paths{$g}->get('resfile') .
## 	      "\",\n          type=chi, group=$gr)\n";
## 	  $paths{$g}->make(imported_res=>1);
## 	};
##       };
    };


    if ($sp =~ /^r/) {
      $precmd .= $paths{$g} -> write_fft($kw, $config{data}{rmax_out});
    } elsif ($sp =~ /^q/) {
      $precmd .= $paths{$g} -> write_fft($kw, $config{data}{rmax_out});
      $precmd .= $paths{$g} -> write_bft();
    };
    my $grp = ($paths{$g}->type eq 'path') ? $group : $paths{$g}->get('group');
    if ($sp =~ /k(\d)/) {
      $precmd  .= "$grp.chi$1 = $grp.$x^$1 * $grp.$y\n";
      $command .= ", $grp.chi$1";
      $erase   .= "erase $grp.chi$1\n";
    } else {
      $command .= ", $grp.$y";
    };
    ++$ncol;
    my $ntit = $ncol+2;
    $paths{$g}->dispose("\$selected_title_$ntit = \"".$paths{$g}->descriptor()." (column " . eval("$ncol+1") . ")\"", $dmode);
    $erase .= "erase \$selected_title_$ntit\n"
  };
  $Text::Wrap::huge = 'overflow';
  ## remove blanks from column labels
  @column_labels = map { $_ =~ s/\s+/_/g; $_ } @column_labels;
  my $label = join(" ", @column_labels);
  $command = wrap("write_data(", "           ", $command);
  $command .= ",\n           label=\"$label\")";
  $paths{$current} -> dispose($precmd,  $dmode);
  $paths{$current} -> dispose($command, $dmode);
  $paths{$current} -> dispose($erase,   $dmode); # clean up the mess
  Echo("Saved $mess for the selected data to \`$file\'");
  $top->Unbusy;
};


sub save_full_data {
  my $data = $paths{$current}->data;
  my ($space, $part);
 SWITCH: {
    ($space, $part) = ('k', 'chi'),      last SWITCH if ($_[0] eq 'k');
    ($space, $part) = ('r', 'chir_mag'), last SWITCH if ($_[0] eq 'r_mag');
    ($space, $part) = ('r', 'chir_re'),  last SWITCH if ($_[0] eq 'r_re');
    ($space, $part) = ('r', 'chir_im'),  last SWITCH if ($_[0] eq 'r_im');
    ($space, $part) = ('q', 'chiq_mag'), last SWITCH if ($_[0] eq 'q_mag');
    ($space, $part) = ('q', 'chiq_re'),  last SWITCH if ($_[0] eq 'q_re');
    ($space, $part) = ('q', 'chiq_im'),  last SWITCH if ($_[0] eq 'q_im');
  };

  my $lab = $paths{$data}->descriptor;
  my $label = "$space ";
  my $kw = $plot_features{kweight};
  ($kw = $paths{$data}->default_k_weight) if ($kw eq 'kw');
  my $which = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');

  my $types = [['All Files', '*'],['Data Files', '*.dat']];
  my $path = $current_data_dir || Cwd::cwd;
  (my $init = $paths{$which}->descriptor) =~ s/[.:@&\/\\ ]+/_/g;
  $init .= "_full.$part";
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$init,
				 -title => "Artemis: Save full data and fit");
  ## make sure I can write to $file
  open F, ">".$file or do { Error("You cannot write to \"$file\".  Check the permissions of that file.");
			    $top -> Unbusy;
			    return };
  close F;
  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  Echo("Saving full data and fit for ". $paths{$which}->descriptor . " ...");
  $top->Busy;

  my ($command, $precmd)  = ("", "");
  my $n = 3;
  $paths{$data}->dispose("\$full_title_1 = \"Artemis output file, full data -- Artemis version $VERSION\"", $dmode);
  $paths{$data}->dispose("\$full_title_2 = \"This file contains the full data from from $lab\"", $dmode);
  my $erase = "erase \$full_title_1\nerase \$full_title_2\n";
  my $header_file = $paths{$which}->get('fitfile');
  $header_file =~ s/(data\d+)\.fit$/header.$1/;
  open H, $header_file;
  foreach (<H>) {
    chomp;
    my $l = substr($_, 2);
    $precmd .= "\$full_title_$n = \"$l\"\n";
    $erase .= "erase \$full_title_$n\n";
    ++$n;
  };
  close H;

##   foreach my $l (split(/\n/, $paths{$data}->param_summary($kw))) {
##     $precmd .= "\$full_title_$n = \"$l\"\n";
##     ++$n;
##     $erase .= "erase \$full_title_1\n";
##   };
  (my $nospaces = $lab) =~ s/[.:@&\/\\ ]+/_/g;
  $label .= "$nospaces ";
  ##   foreach my $t (split(/\n/,$titles)) {
  ##     next if ($t =~ /^\s*$/);
  ##     $command .= "\$artemis_title$n = \"$t\"\n";
  ##     ++$n;
  ##   };

  ## take care to do the FTs uising the parameters of the fit and not
  ## of the data!  this is easiest done by doing write_fft and
  ## write_bft on the chosen fit and substituting in the correct
  ## ifeffit group name

  my $group = $paths{$which}->get('group');
  my $data_group = $paths{$data}->get('group');
  my $fft_command = $paths{$which} -> write_fft($kw, $config{data}{rmax_out});
  my $bft_command = $paths{$which} -> write_bft();

  ## --- data
  $command .= "\$full_title_\*, " . $paths{$data}->get('group') . ".$space, " .
    $paths{$data}->get('group') . ".$part, ";
  if ($space =~ /^k/) {
    (my $this_fft = $fft_command) =~ s/$group/$data_group/g;
    $precmd .= $this_fft;
    ##$precmd .= $paths{$data} -> write_fft($kw, $config{data}{rmax_out});
  } elsif ($space =~ /^[rq]/) {
    (my $this_fft = $fft_command) =~ s/$group/$data_group/g;
    $precmd .= $this_fft;
    (my $this_bft = $bft_command) =~ s/$group/$data_group/g;
    $precmd .= $this_bft;
    ##$precmd .= $paths{$data} -> write_bft();
  };

  ## --- fit
  unless ($paths{$which}->get('imported')) {
    $precmd .= "read_data(file=\"" .
      $paths{$which}->get('fitfile') . "\",\n" . "          type=chi, group=$group)\n";
    $paths{$which}->make(imported=>1);
  };
  if ($space =~ /^r/) {
    $precmd .= $fft_command;
  } elsif ($space =~ /^q/) {
    $precmd .= $fft_command;
    $precmd .= $bft_command;
  };
  $command .=  "$group.$part, ";
  $label .= "fit ";

  ## --- background
  if (-e $paths{$which}->get('bkgfile')) {
    (my $gr = $paths{$which}->get('group')) =~ s/fit/bkg/;
    unless ($paths{$which}->get('imported_bkg')) {
      ## read this fit into its group if it has not already been imported
      $precmd .= "read_data(file=\"" .
	$paths{$which}->get('bkgfile') .
	  "\",\n          type=chi, group=$gr)\n";
      $paths{$which}->make(imported_bkg=>1);
    };
    if ($space =~ /^r/) {
      (my $this_fft = $fft_command) =~ s/$group/$gr/g;
      $precmd .= $this_fft;
    } elsif ($space =~ /^q/) {
      (my $this_fft = $fft_command) =~ s/$group/$gr/g;
      $precmd .= $this_fft;
      (my $this_bft = $bft_command) =~ s/$group/$gr/g;
      $precmd .= $this_bft;
    };
    $command .=  "$gr.$part, ";
    $label .= "background ";
  };

  ## --- residual
  (my $gr = $paths{$which}->get('group')) =~ s/fit/res/;
  unless ($paths{$which}->get('imported_res')) {
    ## read this fit into its group if it has not already been imported
    $precmd .= "read_data(file=\"" .
      $paths{$which}->get('resfile') .
	"\",\n          type=chi, group=$gr)\n";
    $paths{$which}->make(imported_res=>1);
  };
  if ($space =~ /^r/) {
    (my $this_fft = $fft_command) =~ s/$group/$gr/g;
    $precmd .= $this_fft;
  } elsif ($space =~ /^q/) {
    (my $this_fft = $fft_command) =~ s/$group/$gr/g;
    $precmd .= $this_fft;
    (my $this_bft = $bft_command) =~ s/$group/$gr/g;
    $precmd .= $this_bft;
  };
  $command .=  "$gr.$part, ";
  $label .= "residual ";

  ## --- window
  $group = $paths{$data}->get('group');
  if ($space =~ /^r/) {
    $paths{$data} -> dispose("___x = ceil($group.chir_mag)", 1); # scale window to plot
    my $scale = $plot_features{window_multiplier} * Ifeffit::get_scalar("___x");
    $precmd .= "set $group.winout = $scale * $group.rwin\n";
  } else {
    $paths{$data} -> dispose("___x = ceil($group.chi)", 1); # scale window to plot
    my $scale = $plot_features{window_multiplier} * Ifeffit::get_scalar("___x");
    $precmd .= "set $group.winout = $scale * $group.win\n";
  };
  $command .=  "$group.winout, ";
  $label .= "window";


  $command = "write_data(file=$file,\n" . wrap("           ", "           ", $command);
  $command .= "\n           label=\"$label\")";
  $paths{$which} -> dispose($precmd,  $dmode);
  $paths{$which} -> dispose($command, $dmode);
  $paths{$which} -> dispose($erase,   $dmode); # clean up the mess
  Echo("Saving full data and fit for ". $paths{$which}->descriptor . " ... done!");
  $top->Unbusy;

};

sub save_bkgsub_data {
  my $data  = $paths{$current}->data;
  my $label = $paths{$current}->get("lab");
  my $types = [['chi Files', '*.chi'],
	       ['All Files', '*'],];
  my $path = File::Spec->catfile($project_folder, "chi_data", "");
  my $fname = basename($paths{$data}->get('file'));
  my @list = split(/\./, $fname);
  $fname = $list[0] . "_bkgsub." . $list[1];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$fname,
				 -title => "Artemis: Save background subtracted data");
  return unless $file;

  my $group = $paths{$data}->get('group');
  my $command = "\$artemis_title1 = \"Artemis output file, bkgsub -- Artemis version $VERSION\"\n";
  my $titles = $widgets{op_titles}->get(qw(1.0 end));
  my $n = 2;
  foreach my $t (split(/\n/,$titles)) {
    next if ($t =~ /^\s*$/);
    $command .= "\$artemis_title$n = \"$t\"\n";
    ++$n;
  };
  $command .= "\$artemis_title$n = \"artemis: " . $paths{$data}->get('lab') . " as background subtracted chi(k)\"\n";

  ## make and write bkgsub data
  if ($config{data}{bkgsub_window}) {
    $command .= "## note: weighting spline by window in background subtraction!!\n";
    $command .= "set $group.chib = $group.chi - (${group}_bkg.chi*$group.win)\n";
  } else {
    $command .= "set $group.chib = $group.chi - ${group}_bkg.chi\n";
  };
  $command .= "write_data(file=$file,\n" .
    wrap("           ", "           ", "\$artemis_title*, $group.k, $group.chib)");

  $paths{$data} -> dispose($command, $dmode);
  project_state(0);

  ## offer to reload the bkg sub data
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Would you like to replace the current data set with the background subtracted data?",
		   -title          => 'Athena: Replace data?',
		   -buttons        => [qw/Yes No/],
		   -default_button => 'Yes',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  if ($dialog->Show() eq 'Yes') {
    ##my $cdd_save = $current_data_dir;
    &read_data($paths{$current}->data, $file, 1);
    $paths{$current} -> make(lab=>"bkgsub " . $label);
    $list -> entryconfigure($paths{$current}->get('id'), -text=>$paths{$current}->get("lab"));

    ##$current_data_dir = $cdd_save;
    $paths{$data} -> make(do_bkg=>'no');
    $temp{op_do_bkg} = 'no';
    $plot_features{bkg} = 0;
  };
  Echo("Saved background subtracted data to $file");

};

sub bulk_data {
  ## get a list of files from some directory to transfer
  my $path = $current_data_dir || Cwd::cwd;
  my $FSel  = $top->FileSelect(-title => 'Artemis: transfer MANY data files to the project data folder',
			       -width => 40,
			       -directory=>$path);
  $FSel -> configure(-selectmode=>'extended');
  my @data = $FSel->Show;
  Echo("Data transfer was aborted."), return unless (defined $data[0] and -f $data[0]);
  ## transfer 'em
  foreach my $d (@data) {
    my $new = File::Spec->catfile($project_folder, "chi_data", basename($d));
    my $bn  = basename($d, qw(.chi));
    my $count = 1;
    while (-e $new) {		# care not to overwrite files
      $new = File::Spec->catfile($project_folder, "chi_data", $bn."_$count.chi");
      ++$count;
    };
    copy($d, $new) unless ($d eq $new);
  };
  project_state(0);
  ## offer to read one of these newly transfered data files
  &dispatch_read_data($paths{$current}->data, "", 1);
};


sub unique_label {
  my $in = $_[0];
  my $i = 1;
  my $name = $in;
  my $there = 0;
  map {($in eq $paths{$_}->get('lab')) and $there = 1} (&every_data);
  while ($there) {
    $there = 0;
    ++$i;
    $name = join(" ", $in, $i);
    map {($name eq $paths{$_}->get('lab')) and $there = 1} (&every_data);
  };
  return $name;
};


##  END OF THE FILE I/O SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
## READING ATHENA PROJECT FILES IN ARTEMIS


sub read_athena {

  my $prjfile = $_[0];

#   my $was_mac = $paths{data0} ->
#     fix_mac($prjfile, $stash_dir, lc($config{general}{mac_eol}), $top);
#   Echo("Fixed EOL characters for \"$prjfile\".") if ($was_mac == 1);
#   return, Echo("Skipped \"$prjfile\" due to EOL characters.") if ($was_mac == -1);

  my ($tmp, $text);
  my $orig = $prjfile;
  my $athena_fh = gzopen($prjfile, "rb") or die "could not open $prjfile as an Athena project\n";
  ##open(ORIG, "< $prjfile")
  ##  or die "Can't open $prjfile for reading: $!";

  track({file=>$prjfile, mode=>"reading from", command=>sub{my $size = -s $prjfile; print "size : $size\n"}}) if $debug_file_path;

  ##my $athena_fh = *ORIG;
  my @athena_index = ();
  my %athena_group = ();
  my $nline = 0;
  my $line = q{};
  my $cpt = new Safe;
  ##while (<ORIG>) {
  while ($athena_fh->gzreadline($line) > 0) {
    ++$nline;
    next unless ($line =~ /^\$old_group/);
    push @athena_index, $nline;
    ## need to make a map to the groups by old group name so that
    ## background removal with a standard can be performed correctly
    $ {$cpt->varglob('old_group')} = $cpt->reval( $line );
    my $og = $ {$cpt->varglob('old_group')};
    $athena_group{$og} = {index=>$nline, hlist=>0};
  };
  $athena_fh->gzclose();
  ##close ORIG;


  $ath_params{plot}   ||= 'chir_mag';
  $ath_params{params} ||= "project";
  map {$_ -> configure(-state=>'disabled')}
    ($gsd_menu, $feff_menu, $paths_menu, $data_menu, $sum_menu, $fit_menu); #, $settings_menu);
  $edit_menu -> menu -> entryconfigure(13, -state=>'disabled');
 SWITCH: {
    $opparams  -> packForget(), last SWITCH if ($current_canvas eq 'op');
    $gsd       -> packForget(), last SWITCH if ($current_canvas eq 'gsd');
    $feff      -> packForget(), last SWITCH if ($current_canvas eq 'feff');
    $path      -> packForget(), last SWITCH if ($current_canvas eq 'path');
    $logviewer -> packForget(), last SWITCH if ($current_canvas eq 'logview');
  };
  $current_canvas = 'athena';

  my $ath = $fat -> Frame(-relief=>'flat',
			  -borderwidth=>0,
			  -highlightcolor=>$config{colors}{background})
    -> pack(-fill=>'both', -expand=>1);

  my $frm = $ath -> Frame() -> pack(-side=>'top', -anchor=>'w', -padx=>6);

  $frm -> Label(-text=>"Athena project ", @title2)
    -> pack(-side=>'left', -anchor=>'w', -padx=>4);
  $frm -> Label(-textvariable=>\$orig,
		-foreground=>$config{colors}{button})
    -> pack(-side=>'right', -anchor=>'e');


  $widgets{athena_return} = $ath -> Button(-text=>'Cancel and return to the main window',  @button3_list,
					   #-background=>$config{colors}{background},
					   #-activebackground=>$config{colors}{activebackground},
					   -command=>sub{$ath->packForget;
							 $current_canvas = "";
							 $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
							 &display_properties;
							 Echo("Restored normal view");
						       })
    -> pack(-side=>'bottom', -fill=>'x');

  my $labframe = $ath -> LabFrame(-label=>'Athena records',
				  -labelside=>'acrosstop',
				  -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'left', -fill=>'y', -anchor=>'w');
  my $hlist;
  $hlist = $labframe -> Scrolled('HList',
				 -scrollbars=>'osoe',
				 -columns=>1,
				 -header=>0,
				 -selectmode=>'single',
				 -width=>20,
				 -background=>'white',
				 -selectbackground=>$config{colors}{selected},
				 -browsecmd=>sub{athena_plot($hlist, $prjfile, \%athena_group)},
				)
    -> pack(-expand=>1, -fill=>'y');
  $hlist->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
					     ($is_windows) ? () : (-width=>8));
  $hlist->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
					     ($is_windows) ? () : (-width=>8));

  $labframe = $ath -> Frame()
    -> pack(-side=>'right', -expand=>1, -fill=>'both', -anchor=>'n');

  $widgets{help_athena} = $labframe
    -> Button(-text => "Document: Importing Athena project data", @button2_list,
	      -command=>sub{pod_display("artemis_athena.pod")},
	      -width=>65)
    -> pack(-side=>'bottom', -fill=>'x', -padx=>2, -pady=>2);


  my $fr = $labframe -> LabFrame(-label=>'Titles',
				 -labelside=>'acrosstop',
				 -foreground=>$config{colors}{activehighlightcolor})
     -> pack(-side=>'top', -fill=>'x', -padx=>0, -pady=>0);
  $widgets{athena_selected} = $fr;
  $widgets{athena_titles} =  $fr -> Scrolled('ROText',
					     -scrollbars => 'soe',
					     -wrap       => 'none',
					     -height     => 8,)
    -> pack();
  $widgets{athena_titles}->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background},
							      ($is_windows) ? () : (-width=>8));
  $widgets{athena_titles}->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background},
							      ($is_windows) ? () : (-width=>8));


  my @radio_args = (-foreground       => $config{colors}{activehighlightcolor},
		    -activeforeground => $config{colors}{activehighlightcolor},
		    -selectcolor      => $config{colors}{check},
		    -font	      => $config{fonts}{med},
		    -variable	      => \$ath_params{plot},
		    -command	      => sub{athena_plot($hlist, $prjfile, \%athena_group)});

  $fr = $labframe -> LabFrame(-label=>'Plot as ... ',
			      -labelside=>'acrosstop',
			      -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top', -fill=>'both', -pady=>4);
  $fr -> Radiobutton(-text => 'chi(k)',     @radio_args, -value => 'chi', )
    -> grid(-row=>0, -column=>0, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => '|chi(R)|',   @radio_args, -value => 'chir_mag',)
    -> grid(-row=>0, -column=>1, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => '|chi(q)|',   @radio_args, -value => 'chiq_mag', )
    -> grid(-row=>0, -column=>2, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => 'Re[chi(R)]', @radio_args, -value => 'chir_re', )
    -> grid(-row=>1, -column=>1, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => 'Re[chi(q)]', @radio_args, -value => 'chiq_re', )
    -> grid(-row=>1, -column=>2, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => 'Im[chi(R)]', @radio_args, -value => 'chir_im', )
    -> grid(-row=>2, -column=>1, -padx=>2, -sticky=>'w');
  $fr -> Radiobutton(-text => 'Im[chi(q)]', @radio_args, -value => 'chiq_im', )
    -> grid(-row=>2, -column=>2, -padx=>2, -sticky=>'w');


  $fr = $labframe -> Frame()
    -> pack(-side=>'top', -fill=>'x', -pady=>4, -padx=>4);
  $fr -> Radiobutton(-text	       =>"Use parameters from Athena project",
		     -foreground       => $config{colors}{activehighlightcolor},
		     -activeforeground => $config{colors}{activehighlightcolor},
		     -selectcolor      => $config{colors}{check},
		     -font	       => $config{fonts}{med},
		     -variable	       => \$ath_params{params},
		     -value	       => 'project' )
    -> pack(-side =>'top', -anchor=>'w');
  $fr -> Radiobutton(-text	       =>"Use default parameters",
		     -foreground       => $config{colors}{activehighlightcolor},
		     -activeforeground => $config{colors}{activehighlightcolor},
		     -selectcolor      => $config{colors}{check},
		     -font	       => $config{fonts}{med},
		     -variable	       => \$ath_params{params},
		     -value	       => 'default' )
    -> pack(-side=>'top', -anchor=>'w');


  $labframe -> Button(-text=>"Import these data",
		      @button3_list,
		      -command=>sub{
			$ath->packForget;
			$current_canvas = "";
			$edit_menu -> menu -> entryconfigure(13, -state=>'normal');
			athena_import($hlist, $prjfile, $orig, $ath_params{params});
		      })
    -> pack(-side=>'top', -fill=>'x', -pady=>10, -padx=>4);



  my @groups = ();
  my @group_lines = ();
  my $old_group = "";
  my $line_number = 1;

  #foreach my $i (@athena_index) {
  foreach my $g (sort {$athena_group{$a}{index} <=> $athena_group{$b}{index}} keys(%athena_group)) {
    my $i = $athena_group{$g}{index};
    my %args = athena_get_array($prjfile, $i, "args");
    $args{label} =~ s{[\"\']}{}g;
    next unless ($args{is_xmu} or $args{is_chi});
    $hlist -> add($i, -data=>$i);
    $hlist -> itemCreate($i, 0, -text=>$args{label});
    $athena_group{$g}{hlist} = $i;
  };
  $hlist -> anchorSet($athena_index[0]);
  $hlist -> selectionSet($athena_index[0]);
  athena_plot($hlist, $prjfile, \%athena_group);

## set_fit_button('fit');

};

## This is, perhaps, a bit slow.  It reads linearly through an athena
## project file until it finds the specified group, then it imports
## the requested array.

## arg 0 is the project file name
## arg 1 is the line in the file with that record (already found)
## arg 2 is one of: args x y stddev i0
sub athena_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 athena_plot {

  $top -> Busy;
  my $n = $_[0]->info('anchor');
  my $i = $_[0]->info('data', $n);
  my $prjfile = $_[1];
  my $r_athena_group = $_[2];
  my $noplot = $_[3];
  my $gname = "a___thena" ;
  if ($noplot) {
    $n = $r_athena_group->{$noplot}->{hlist};
    $i = $_[0]->info('data', $n);
    $gname = "st___andard";
  };

  ## get the args hash
  my %args = athena_get_array($prjfile, $i, "args");
  $args{fft_kw} ||= 2;

  ## get the x- and y-axis arrays
  my @x = athena_get_array($prjfile, $i, "x");
  @x = map {$_ + $args{bkg_eshift}} @x;
  my @y = athena_get_array($prjfile, $i, "y");

  my %clamp = ("None" => 0, "Slight" => 3, "Weak" => 6, "Medium" =>12, "Strong" => 24, "Rigid" => 96);
  my $title = $args{label};
  $widgets{athena_selected}  -> configure(-label=>"Header lines for " . $title);

  $widgets{athena_titles} -> delete(qw(1.0 end));
  foreach my $l (@{$args{titles}}) {
    $widgets{athena_titles} -> insert('end', $l.$/);
  };

  $paths{data0}->dispose("erase \@group $gname\n");
  $paths{data0}->dispose("##\n## reading Athena record \"$title\" into group $gname:", $dmode);
  $paths{data0}->dispose("set \&status=0", $dmode);
  if ($args{is_xmu}) {
    Ifeffit::put_array($gname.".energy", \@x);
    Ifeffit::put_array($gname.".xmu", \@y);
    #Ifeffit::ifeffit("newplot($gname.energy, $gname.xmu)\n");
    #print join(" ", %args), $/;
    #sleep 5;
    $args{bkg_clamp1} = $clamp{$args{bkg_clamp1}};
    $args{bkg_clamp2} = $clamp{$args{bkg_clamp2}};

    my $stan_string = q{};
    if ($args{bkg_stan} ne 'None') {
      athena_plot($_[0], $_[1], $r_athena_group, $args{bkg_stan});
      $stan_string = "k_std=st___andard.k, chi_std=st___andard.chi, ";
      ## need to remove background function from standard if standard
      ## is mu(E) data!
    };

    my $spline  = "$gname.energy, $gname.xmu, e0=$args{bkg_e0}, ";
    $spline    .= "rbkg=$args{bkg_rbkg}, kmin=$args{bkg_spl1}, ";
    $spline    .= "kmax=$args{bkg_spl2}, kweight=$args{bkg_kw}, ";
    $spline    .= "dk=$args{bkg_dk}, kwindow=$args{bkg_win}, pre1=$args{bkg_pre1}, ";
    $spline    .= "pre2=$args{bkg_pre2}, norm1=$args{bkg_nor1}, norm2=$args{bkg_nor2}, ";
    $spline    .= "clamp1=$args{bkg_clamp1}, clamp2=$args{bkg_clamp2}, nclamp=5, ";
    $spline    .= $stan_string;
    $spline    .= "interp=quad)\n";
    $spline     = wrap("spline(", "       ", $spline);
    ## remove the background and plot the data
    Echo("Removing background from Athena record \"$title\"");
    $paths{data0}->dispose($spline, $dmode);
    my $status = Ifeffit::get_scalar('&status');
    $paths{data0}->dispose($spline, $dmode) if ($status > 1);
    #Ifeffit::ifeffit("newplot($gname.k, $gname.k*$gname.chi)\n");
    #sleep 5;
    $paths{data0}->dispose("set \&status=0", $dmode);
  } else {
    Ifeffit::put_array("$gname.k", \@x);
    Ifeffit::put_array("$gname.chi", \@y);
  };

  $top -> Unbusy, return if $noplot;
  my ($plot, $sp);
  ## plot this in k-space
  if ($ath_params{plot} eq 'chi') {
    my $ylabel = "";
  SWITCH: {
      $ylabel = '\\gx(k)',                last SWITCH if ($args{fft_kw} == 0);
      $ylabel = 'k\\gx(k) (\\A\\u-1\\d)', last SWITCH if ($args{fft_kw} == 1);
      $ylabel = 'k\\u' . $args{fft_kw} . '\\d\\gx(k) (\\A\\u-' . $args{fft_kw} . '\\d)';
    };
    $plot  = "a___thena.k, a___thena.chi*a___thena.k**$args{fft_kw}, title=$title, ";
    $plot .= "xlabel=\"k (\\A\\u-1\\d)\", ylabel=\"$ylabel\", ";
    $plot .= "xmin=$plot_features{kmin}, xmax=$plot_features{kmax})\n";
    $plot = wrap("newplot(", "        ", $plot);
    $sp = 'k';

  ## fft then plot this in R-space
  } elsif ($ath_params{plot} =~ /chir/) {
    my $ylabel = '';
  SWITCH: {
      $ylabel = sprintf("|\\gx(R)| (\\A\\u-%s\\d)",   $plot_features{kweight}+1),
	  last SWITCH if ($ath_params{plot} =~ /mag$/);
      $ylabel = sprintf("Re[\\gx(R)] (\\A\\u-%s\\d)", $plot_features{kweight}+1),
	  last SWITCH if ($ath_params{plot} =~ /re$/);
      $ylabel = sprintf("Im[\\gx(R)] (\\A\\u-%s\\d)", $plot_features{kweight}+1),
	  last SWITCH if ($ath_params{plot} =~ /im$/);
    };
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$plot_features{kweight}, ";
    $fft     .= "kmin=$args{fft_kmin}, kmax=$args{fft_kmax}, ";
    $fft     .= "dk=$args{fft_dk}, kwindow=$args{fft_win})\n";
    $fft      = wrap("fftf(", "     ", $fft);
    $paths{data0}->dispose($fft, $dmode);
    $plot  = "a___thena.r, a___thena.$ath_params{plot}, title=$title, ";
    $plot .= "xlabel=\"R (\\A)\", ylabel=\"$ylabel\", style=lines, ";
    $plot .= "xmin=$plot_features{rmin}, xmax=$plot_features{rmax})\n";
    $plot  = wrap("newplot(", "        ", $plot);
    $sp = 'R';

  ## fft, bft, then plot this in q-space
  } else {
    my $ylabel = '';
  SWITCH: {
      $ylabel = sprintf("|\\gx(q)| (\\A\\u-%s\\d)",   $plot_features{kweight}),
	  last SWITCH if ($ath_params{plot} =~ /mag$/);
      $ylabel = sprintf("Re[\\gx(q)] (\\A\\u-%s\\d)", $plot_features{kweight}),
	  last SWITCH if ($ath_params{plot} =~ /re$/);
      $ylabel = sprintf("Im[\\gx(q)] (\\A\\u-%s\\d)", $plot_features{kweight}),
	  last SWITCH if ($ath_params{plot} =~ /im$/);
    };
    my $fft   = "a___thena.chi, k=a___thena.k, kweight=$plot_features{kweight}, ";
    $fft     .= "kmin=$args{fft_kmin}, kmax=$args{fft_kmax}, ";
    $fft     .= "dk=$args{fft_dk}, kwindow=$args{fft_win})\n";
    $fft      = wrap("fftf(", "     ", $fft);
    $paths{data0}->dispose($fft, $dmode);
    my $bft   = "real=a___thena.chir_re, imag=a___thena.chir_im, ";
    $bft     .= "rmin=$args{bft_rmin}, rmax=$args{bft_rmax}, ";
    $bft     .= "dr=$args{bft_dr}, rwindow=$args{bft_win})\n";
    $bft      = wrap("fftr(", "     ", $bft);
    $paths{data0}->dispose($bft, $dmode);
    $plot  = "a___thena.q, a___thena.$ath_params{plot}, title=$title, ";
    $plot .= "xlabel=\"q (\\A\\u-1\\d)\", ylabel=\"$ylabel\", ";
    $plot .= "xmin=$plot_features{qmin}, xmax=$plot_features{qmax})\n";
    $plot  = wrap("newplot(", "        ", $plot);
    $sp = 'q';
  };


  Echo("Plotting Athena record \"$title\"");
  $paths{data0}->dispose($plot, $dmode);

  Echo("This is Athena record \"$title\" plotted in $sp-space");
  $top -> Unbusy;
};

sub athena_import {

  my ($group, $response) = ("", "New");
  my @data = &every_data;
  if ($#data or $paths{$paths{$current}->data}->get('file')) {
    my $message = "Do you wish to read in a new data file (that is, to do multiple data set fitting), or do you wish to change the current data file (that is, to apply this fitting model to a different data set) ?";
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => $message,
		     -title          => 'Athena: Reading data',
		     -buttons        => [qw/Change New Cancel/],
		     -default_button => 'Change',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    $response = $dialog->Show();
    if ($response eq 'Cancel') {
      ## remove the index file
      my $indexname = File::Spec->catfile($project_folder, "tmp", "index");
      unlink $indexname if (-e $indexname);
      $group = $list->info('anchor') || 'data0';
      $current_canvas = "";
      $list->see($group);
      $list->anchorSet($group);
      &display_properties(0);
      Echo("Import of Athena record aborted");
      return;
    } elsif ($response eq 'Change') {
      Echo("Changing data ...");
    } else {
      Echo("Importing new data ...");
    };
  };

  $top->Busy;

  my $n = $_[0]->info('anchor');
  my $line = $_[0]->info('data', $n);
  my $how_params = $_[3];

  ## get the args hash
  my %args = athena_get_array($_[1], $line, "args");
  $args{fft_kw} ||= 2;
  $args{label} =~ s{[\"\']}{}g;

  my $i = 1;
  my $erase = "";
  foreach my $l (@{$args{titles}}) {
    Ifeffit::put_string("athena_title_$i",$l);
    $erase .= "erase \$athena_title_$i\n";
    ++$i;
  };
  (my $fname = $args{label}) =~ s/[.,:@&\/\\ ]/_/g;
  my $file = File::Spec->catfile($project_folder, "chi_data", $fname.".chi");
  $paths{data0}->dispose("write_data(file=$file,\n           a___thena.k, a___thena.chi, \$athena_title_*)", $dmode);
  if ($args{is_xmu}) {
    my $file = File::Spec->catfile($project_folder, "chi_data", $fname.".xmu");
    $paths{data0}->dispose("write_data(file=$file,\n           a___thena.energy, a___thena.xmu, \$athena_title_*)", $dmode);
  };

  $group = ($response eq 'Change') ?
    read_data($paths{$current}->data, $file, 1) :
      read_data(0, $file, 1);

  if ($args{is_chi}) {
    $paths{$group} -> make(is_xmu=>0, is_chi=>1);
  } else {
    $paths{$group} -> make(is_xmu=>1, is_chi=>0);
  };
  if ($how_params eq 'project') {		# use project parameters
    Echo("Setting parameters to values from Athena project");
    my $rmin = $args{bft_rmin};
    ($rmin = $args{bkg_rbkg}) if ($args{bkg_rbkg} > $args{bft_rmin});
    $paths{$group} -> make(kmin	       => $args{fft_kmin},
			   kmax	       => $args{fft_kmax},
			   dk	       => $args{fft_dk},
			   kwindow     => $args{fft_win},
			   rmin	       => $rmin,
			   rmax	       => $args{bft_rmax},
			   dr	       => $args{bft_dr},
			   rwindow     => $args{bft_win},
			   lab	       => $args{label},
			   k1	       => 0,
			   k2	       => 0,
			   k3	       => 0,
			   fs_absorber => $args{bkg_z},
			   fs_edge     => $args{fft_edge},
			  );
    $paths{$group} -> make(k1 => 1) if ($config{data}{kweight} == 1);
    $paths{$group} -> make(k2 => 1) if ($config{data}{kweight} == 2);
    $paths{$group} -> make(k3 => 1) if ($config{data}{kweight} == 3);
    $paths{$group} -> make(k2 => 1) if not (   $paths{$group}->get('k1')
					    or $paths{$group}->get('k2')
					    or $paths{$group}->get('k3'));
  } elsif ($response eq 'Change') { # replacing data, maintain params
    Echo("Maintaining parameter values from previous data");
    $paths{$group} -> make(lab	       => $args{label});
  } else { 			# new data, use artemis defaults
    Echo("Setting parameters to Artemis default values");
    $paths{$group} -> make(kmin        => $config{data}{kmin},
			   kmax        => $config{data}{kmax},
			   dk          => $config{data}{dk},
			   k1          => ($config{data}{kweight} == 1),
			   k2          => ($config{data}{kweight} == 2),
			   k3          => ($config{data}{kweight} == 3),
			   rmin        => $config{data}{rmin},
			   rmax        => $config{data}{rmax},
			   dr          => $config{data}{dr},
			   kwindow     => $config{data}{kwindow},
			   rwindow     => $config{data}{rwindow},
			   lab	       => $args{label},
			   fs_absorber => $args{bkg_z},
			   fs_edge     => $args{fft_edge},
			  );

    # interpret the range parameters
    if ($paths{$group}->get('kmax') == 0) {
      $paths{$group}->make(kmax=>15);
      my ($epsk, $epsr, $suggest) = $paths{$group}->chi_noise;
      $suggest ||= 15;
      $paths{$group}->make(kmax=>$suggest);
    };
    $paths{$group} -> fix_values();

  };
  ## parameters for the mu(E) tab
  if ($paths{$group}->get("is_xmu")) {
    foreach my $k (qw(e0 eshift kw rbkg dk pre1 pre2 nor1 nor2 spl1 spl2
	              slope int step fitted_step fixstep nc0
		      nc1 nc2 flatten stan clamp1 clamp2)) {
      $paths{$group} -> make("bkg_".$k => $args{"bkg_".$k});
    };
    $paths{$group} -> make(do_xmu=>1, is_xmu=>1);
  };
  $list -> itemConfigure($group, 0, -text=>$args{label});
  populate_op($group);
  $plot_features{kweight} = $args{fft_kw};
  plot('r', 0);
  ##--bkg-- $widgets{data_notebook} -> raise('chi');
  ##--bkg-- $widgets{data_notebook} -> pageconfigure('bkg', -state=>'normal') if $paths{$group}->get('is_xmu');

  ## push the athena project onto the MRU list
  &push_mru($_[2], 1, "athena");

  ## remove the index file
  my $indexname = File::Spec->catfile($project_folder, "tmp", "index");
  unlink $indexname if (-e $indexname);

  ## clean up ifeffit
  $paths{$group}->dispose($erase, $dmode);
  $paths{$group}->dispose("erase \@group a___thena\n", $dmode);

  $top->Unbusy;
  project_state(0);
  Echo("Imported Athena record \"$args{label}\"");
};


## sub build_index {
##   my $data_file  = shift;
##   my $index_file = shift;
##   my $offset     = 0;
##
##   while (<$data_file>) {
##     print $index_file pack("N", $offset);
##     $offset = tell($data_file);
##   }
## }
##
## # usage: line_with_index(*DATA_HANDLE, *INDEX_HANDLE, $LINE_NUMBER)
## # returns line or undef if LINE_NUMBER was out of range
## sub line_with_index {
##   my $data_file   = shift;
##   my $index_file  = shift;
##   my $line_number = shift;
##
##   my $size;			# size of an index entry
##   my $i_offset;			# offset into the index of the entry
##   my $entry;			# index entry
##   my $d_offset;			# offset into the data file
##
##   $size = length(pack("N", 0));
##   $i_offset = $size * ($line_number-1);
##   seek($index_file, $i_offset, 0) or return;
##   read($index_file, $entry, $size);
##   $d_offset = unpack("N", $entry);
##   seek($data_file, $d_offset, 0);
##   return scalar(<$data_file>);
## }


sub clear_athena {
  foreach my $k (qw(e0 eshift kw rbkg pre1 pre2 nor1 nor2 spl1 spl2 step)) {
    my $key = "bkg_".$k;
    $widgets{$key} -> configure(-validate=>'none');
    $widgets{$key} -> delete(qw(0 end));
    $widgets{$key} -> configure(-validate=>'key');
  };
  $temp{bkg_fixstep} = 0;
  $temp{bkg_flatten} = 1;
  $temp{bkg_clamp2}  = 'None';
};

##  END OF THE ATHENA SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##
###===================================================================
###  QUICK FIRST SHELL FIT SUBSYSTEM
###===================================================================


sub firstshell {

  my $do_fit = $_[0];
  ## do not do this unless there is one data set imported and no feff calculations
  my ($n,$ok,$d) = (0,0,"");
  foreach (&all_data) {
    ++$n;			# counts data objects
    ++$ok if (-e $paths{$_}->get('file')); # counts actual data files
    $d = $_;
  };

  if ($do_fit) {
    Error("No data!"), return if ($ok == 0);
    Error("Automated first shell fitting is for single data set fits only."), return if (($ok >= 2) or ($n >= 2));
    Error("You need to delete all your Feff calculations before trying an automated first shell fit."), return if data_paths($d);
  };

  my $data = $paths{$current}->data;
  my %fs_params = (coordination => '6-coordinate crystal',
		   scatterer    => 'O',
		   distance     => '2.0',
		   absorber     => $paths{$data}->get('fs_absorber') || 'Cu',
		   edge         => $paths{$data}->get('fs_edge')     || 'K',
		   do_fit       => $do_fit,
	       );
  map {$_ -> configure(-state=>'disabled')}
    ($gsd_menu, $feff_menu, $paths_menu, $data_menu, $sum_menu, $fit_menu); #, $settings_menu);
  $edit_menu -> menu -> entryconfigure(13, -state=>'disabled');
 SWITCH: {
    $opparams  -> packForget(), last SWITCH if ($current_canvas eq 'op');
    $gsd       -> packForget(), last SWITCH if ($current_canvas eq 'gsd');
    $feff      -> packForget(), last SWITCH if ($current_canvas eq 'feff');
    $path      -> packForget(), last SWITCH if ($current_canvas eq 'path');
    $logviewer -> packForget(), last SWITCH if ($current_canvas eq 'logview');
  };
  $current_canvas = 'firstshell';

  my $fs = $fat -> Frame(-relief=>'flat',
			 -borderwidth=>0,
			 -highlightcolor=>$config{colors}{background})
    -> pack(-fill=>'both', -expand=>1);

  my $frm = $fs -> Frame() -> pack(-side=>'top', -anchor=>'w', -padx=>6);
  $frm -> Label(-text=>"Automated first shell fit", @title2)
    -> pack(-side=>'left', -anchor=>'w', -padx=>4);

  $frm = $fs -> LabFrame(-label=>"Automated fit parameters",
			 -labelside=>'acrosstop',
			 -foreground=>$config{colors}{activehighlightcolor})
    -> pack(-side=>'top');

  $frm -> Label(-text       => 'Absorbing atom: ',
		-width      => 30,
		-anchor     => 'e',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>0, -column=>0, -sticky=>'e', -pady=>2);
  $frm -> Entry(-width=>5,
		-textvariable=>\$fs_params{absorber}
		)
    -> grid(-row=>0, -column=>1, -sticky=>'w', -pady=>2);

  $frm -> Label(-text       => 'Edge: ',
		-width      => 30,
		-anchor     => 'e',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>1, -column=>0, -sticky=>'e', -pady=>2);
  $frm -> Optionmenu(-options=>[qw(K L1 L2 L3)],
		     -textvariable=>\$fs_params{edge},
		     -borderwidth=>1,
		    )
    -> grid(-row=>1, -column=>1, -columnspan=>2, -sticky=>'w', -pady=>2);

  $frm -> Label(-text       => 'Scattering atom: ',
		-width      => 30,
		-anchor     => 'e',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>2, -column=>0, -sticky=>'e', -pady=>2);
  $frm -> Entry(-width=>5,
		-textvariable=>\$fs_params{scatterer}
		)
    -> grid(-row=>2, -column=>1, -sticky=>'w', -pady=>2);

  $frm -> Label(-text       => 'Distance: ',
		-width      => 30,
		-anchor     => 'e',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>3, -column=>0, -sticky=>'e', -pady=>2);
  $frm -> Entry(-width=>5,
		-textvariable=>\$fs_params{distance}
		)
    -> grid(-row=>3, -column=>1, -sticky=>'w', -pady=>2);
  $frm -> Label(-text       => "A", #"",
		-anchor     => 'w',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>3, -column=>2, -sticky=>'w', -pady=>2);

  $frm -> Label(-text       => 'Coordination: ',
		-width      => 30,
		-anchor     => 'e',
		-foreground => $config{colors}{activehighlightcolor}
	       )
    -> grid(-row=>4, -column=>0, -sticky=>'e', -pady=>2, -padx=>4);
  $frm -> Optionmenu(-options=>['4-coordinate crystal', '6-coordinate crystal',
				'square planar', 'octahedral', 'tetrahedral'],
		     -textvariable=>\$fs_params{coordination},
		     -borderwidth=>1,
		    )
    -> grid(-row=>4, -column=>1, -columnspan=>2, -sticky=>'ew', -pady=>2);

  $fs -> Button(-text=>'Do it!', @button3_list,
		-command => sub{firstshell_fit($fs, \%fs_params)})
    -> pack(-side=>'top', -fill=>'x', -pady=>2, -padx=>2);

  $fs -> Button(-text=>'Cancel and return to the main window', @button3_list,
		 -command=>sub{$fs->packForget;
			       $current_canvas = "";
			       $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
			       &display_properties;
			       Echo("Restored normal view");
			     })
    -> pack(-side=>'top', -fill=>'x', -pady=>8, -padx=>2);

  $fs -> Button(-text    => 'Document: Automated first shell fit',  @button2_list,
		-command => sub{pod_display("artemis_afs.pod")} )
    -> pack(-side=>'bottom', -fill=>'x', -pady=>2);

};

# 1. generate feff.inp from params
# 2. insert feff.inp into feff.inp display
# 3. run feff
# 4. run fit

sub firstshell_fit {
  my ($canvas, $rparams) = @_;

  Echo("Running automated first shell fit ...");

  unless (lc($$rparams{absorber})  =~ /^$Ifeffit::Files::elem_regex$/) {
    Error("The absorber \"$$rparams{absorber}\" is not a valid element symbol.  Automated fit aborted.");
    return;
  };
  unless (lc($$rparams{scatterer}) =~ /^$Ifeffit::Files::elem_regex$/) {
    Error("The scatterer \"$$rparams{scatterer}\" is not a valid element symbol.  Automated fit aborted.");
    return;
  };
  if ($$rparams{distance} < 0) {
    Error("The distance cannot be negative.  Automated fit aborted.");
    return;
  };
  if ($$rparams{distance} < 1.2) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "$$rparams{distance} Angstroms is an unusually small value for distance.  Are you sure you want to continue?",
		     -title          => 'Athena: Reading data',
		     -buttons        => [qw/OK Cancel/],
		     -default_button => 'Cancel',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    Echo("Automated first shell theory aborted."), return if ($response eq 'Cancel');
  };
  if ($$rparams{distance} > 2.9) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "$$rparams{distance} Angstroms is an unusually large value for distance.  Are you sure you want to continue?",
		     -title          => 'Athena: Reading data',
		     -buttons        => [qw/OK Cancel/],
		     -default_button => 'Cancel',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    Echo("Automated first shell theory aborted."), return if ($response eq 'Cancel');
  };

  $canvas->packForget;
  $current_canvas = "";
  $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
  &display_properties;
  Echo("Restored normal view");
  project_state(0);

  $top -> Busy;

  ## override some config params
  my @save = ($config{general}{fit_query},
	      $config{autoparams}{third},
	      $config{autoparams}{third_type},
	      $config{autoparams}{fourth},
	      $config{autoparams}{fourth_type});
  ($config{general}{fit_query},
   $config{autoparams}{third},
   $config{autoparams}{third_type},
   $config{autoparams}{fourth},
   $config{autoparams}{fourth_type}) = (0, 'c3', 'set', 'c4', 'set');

  ## make the feff.inp file from the firstshell params
  if ($$rparams{coordination} =~ /^[46]-coordinate/) {
    make_feffinp_crystal($rparams);
  } else {
    make_feffinp_molecule($rparams);
  };

  ## run the feff calc and import only the first path
  run_feff($current, 'Just the first');

  ## set the degeneracy to 1 so that amp is "directly" interpretable as the
  ## coordination
  set_degeneracy(1);

  ## run the fit
  generate_script(1) if $$rparams{do_fit};

  ## restore the config params
  ($config{general}{fit_query},
   $config{autoparams}{third},
   $config{autoparams}{third_type},
   $config{autoparams}{fourth},
   $config{autoparams}{fourth_type}) = @save;

  my $data = $paths{$current} -> data;
  $paths{$data} -> make(fs_absorber	 => $$rparams{absorber},
			fs_edge		 => $$rparams{edge},
			#fs_scatterer	 => $$rparams{scatterer},
			#fs_distance	 => $$rparams{distance},
			#fs_coordination => $$rparams{coordination},
		       );
  $top -> Unbusy;
  Echo("Running automated first shell fit ... done!");

};

sub make_feffinp_crystal {
  my $rparams = $_[0];

  ## 6 coordinate: space=f m -3 m, a=2*R  abs=000  scat=1/2 1/2 1/2
  ## 4 coordinate: space=F -4 3 m, a=4*R/sqrt(3)   abs=000  scat=1/4 1/4 1/4
  my ($a, $space, $x);
 SWITCH: {
    ($a, $space, $x) = (2*$$rparams{distance},         'F m -3 m', 0.5),  last SWITCH if ($$rparams{coordination} =~ /^6/);
    ($a, $space, $x) = (4*$$rparams{distance}/sqrt(3), 'F -4 3 m', 0.25), last SWITCH if ($$rparams{coordination} =~ /^4/);
  };

  my $keywords = Xray::Atoms -> new(die=>1);
  $keywords -> make(identity => "Artemis $VERSION",
		    quiet    => 1,
		    program  => 'Artemis',
		    core     => $$rparams{absorber},
		    edge     => $$rparams{edge},
		    space    => $space,
		    a	     => $a,
		    rmax     => 1.1*$a,
		   );
  $keywords -> make(title=>"Quick first shell theory: $$rparams{absorber}-$$rparams{scatterer}");
  $keywords -> make(title=>"$$rparams{coordination}, $$rparams{distance} A, $$rparams{edge} edge");
  my $cell = Xray::Xtal::Cell -> new();
  $cell -> make( Space_group=>$space, A=>$a, );

  my @sites;
  $sites[0] = Xray::Xtal::Site -> new();
  $sites[0] -> make( X=>0.0, Y=>0.0, Z=>0.0, Element=>$$rparams{absorber} );
  $sites[1] = Xray::Xtal::Site -> new();
  $sites[1] -> make( X=>$x,  Y=>$x,  Z=>$x,  Element=>$$rparams{scatterer} );
  push @{$keywords->{sites}}, [$$rparams{absorber},  0,  0,  0,  $$rparams{absorber},  1];
  push @{$keywords->{sites}}, [$$rparams{scatterer}, $x, $x, $x, $$rparams{scatterer}, 1];

  $cell -> populate(\@sites);

  my $trouble = $keywords -> verify_keywords($cell, \@sites, 1);
  if ($trouble) {
    $top -> Unbusy();
    Error("Trouble found among the parameters.  Atoms aborted.");
    return;
  };

  my (@neutral, @cluster);
  build_cluster($cell, $keywords, \@cluster, \@neutral);
  my $text;
  my ($default_name, $is_feff) =
    &parse_atp("feff", $cell, $keywords, \@cluster, \@neutral, \$text);
  Echo("Made ATP output (feff6) for automated fit");

  my $to  = File::Spec->catfile($project_folder, "tmp", "feff.inp");
  open F, ">".$to;
  print F $text;
  close F;

  read_feff($to);
  unlink $to;

  my $newname = "$$rparams{absorber} - $$rparams{scatterer}";

  $paths{$current} -> make(lab=>$newname);
  $list -> itemConfigure($current, 0, -text=>$newname);

};

sub make_feffinp_molecule {
  my $rparams = $_[0];

  my $ihole = 1;
 SWITCH: {
    $ihole = 2, last SWITCH if (lc($$rparams{edge}) eq 'l1');
    $ihole = 3, last SWITCH if (lc($$rparams{edge}) eq 'l2');
    $ihole = 4, last SWITCH if (lc($$rparams{edge}) eq 'l3');
  };
  my $x = 0;
 GEOM: {
    $x = $$rparams{distance}, last GEOM if ($$rparams{coordination} eq 'square planar');
    $x = $$rparams{distance}, last GEOM if ($$rparams{coordination} eq 'octahedral');
    $x = sprintf("%.5f", $$rparams{distance}/sqrt(3)), last GEOM if ($$rparams{coordination} eq 'tetrahedral');
  };
  my $rmax = 2.1 * $$rparams{distance};

  my $text = "\n TITLE Quick first shell theory: $$rparams{absorber}-$$rparams{scatterer}\n";
  $text .= " TITLE $$rparams{coordination}, $$rparams{distance} A, $$rparams{edge} edge\n";
  $text .= " HOLE  $ihole   1.0\n\n";

  $text .= " *         mphase,mpath,mfeff,mchi\n";
  $text .= " CONTROL   1      1     1     1\n";
  $text .= " PRINT     1      0     0     0\n\n";

  $text .= " RMAX      $rmax\n\n";

  $text .= " POTENTIALS\n";
  $text .= " *    ipot   Z  element\n";
  my $z = get_Z($$rparams{absorber});
  $text .= "       0     $z   $$rparams{absorber}\n";
  $z    = get_Z($$rparams{scatterer});
  $text .= "       1     $z   $$rparams{scatterer}\n\n";

  $text .= " ATOMS\n";
  $text .= " *   x          y          z           ipot\n";
  $text .= sprintf("   %8.5f   %8.5f   %8.5f       0\n",  0, 0, 0);
  if ($$rparams{coordination} eq 'square planar') {
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  $x, 0,  0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n", -$x, 0,  0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0,  $x, 0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0, -$x, 0);
  } elsif ($$rparams{coordination} eq 'octahedral') {
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  $x, 0,  0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n", -$x, 0,  0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0,  $x, 0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0, -$x, 0);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0,  0,  $x);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  0,  0, -$x);
  } elsif ($$rparams{coordination} eq 'tetrahedral') {
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  $x,  $x,  $x);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n", -$x, -$x,  $x);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n", -$x,  $x, -$x);
    $text .= sprintf("   %8.5f   %8.5f   %8.5f       1\n",  $x, -$x, -$x);
  };

  my $to  = File::Spec->catfile($project_folder, "tmp", "feff.inp");
  open F, ">".$to;
  print F $text;
  close F;

  read_feff($to);
  unlink $to;

  my $newname = "$$rparams{absorber} - $$rparams{scatterer}";

  $paths{$current} -> make(lab=>$newname);
  $list -> itemConfigure($current, 0, -text=>$newname);
};

## END OF THE QUICK FIRST SHELL FIT SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2010 Bruce Ravel
##

###===================================================================
### dealing with data
###===================================================================


## return the name of the data at the top of the paths list
sub first_data {
  foreach my $d (&all_data) {
    return $d if ($paths{$d}->get('include'));
  };
  return 'data0';
};

sub next_data {
  my $next = -1;
  foreach my $d (keys %paths) {
    next unless (ref($paths{$d}) =~ /Ifeffit/);
    next unless ($paths{$d}->type eq 'data');
    my $this = $1 if ($d =~ /^data(\d+)$/);
    ($next = $this) if ($this > $next);
  };
  return ($paths{'data'.$next}->{file}) ? $next+1 : $next;
};


## return a list of all data sets included in the fit
sub all_data {
  my @list = (sort (grep {$paths{$_}->get('include')} (grep /^data(\d+)$/, (keys %paths) )));
  my %hash = ();
  foreach my $d (@list) {
    (my $key = $d) =~ s{\Adata}{};
    $hash{$key} = $d;
  };
  @list = @hash{sort {$a <=> $b} keys(%hash)};
  #print "all ", join(" ", @list), $/;
  return @list;
};

## return a list of every data in %paths regardless of whether it is
## included in the fit
sub every_data {
  my @list = (sort (grep /^data(\d+)$/, (keys %paths) ));
  my %hash = ();
  foreach my $d (@list) {
    (my $key = $d) =~ s{\Adata}{};
    $hash{$key} = $d;
  };
  @list = @hash{sort {$a <=> $b} keys(%hash)};
  #print "every ", join(" ", @list), $/;
  return @list;
};

## return a list of all feff calculations associated with the
## specified data set
sub data_feff {
  my $this = shift;
  my @list = ();
  foreach my $p (&path_list) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless $paths{$p}->type;
    next unless ($paths{$p}->type eq 'feff');
    next unless ($paths{$p}->data eq $this);
    push(@list, $p);
  };
  return @list;
};

## return a list of all included paths associated with the specified
## data set
sub data_paths {
  my $this = shift;
  my @list = ();
  foreach my $p (&path_list) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless ($paths{$p}->type eq 'path');
    next unless ($paths{$p}->data eq $this);
    next unless $paths{$p}->get('include');
    push(@list, $p);
  };
  return @list;
};

sub rename_data {
  Error("There is no data."), return unless $n_data;
  my $this = $current;
  $this = $paths{$current}->data;
  ##($this = $paths{$current}->{data}) if (exists $paths{$current}->{data});
  ##($this = &first_data) if ($current eq 'gsd');
  my $oldname = $paths{$this}->get('lab');
  my $newname = $oldname;
  my $label = "New name for data \"$oldname\": ";
  my $dialog = get_string($dmode, $label, \$newname, \@rename_buffer);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Not renaming ". $paths{$this}->get('lab')), return if ($oldname eq $newname);
  $newname =~ s{[\"\']}{}g;
  my $exists = 0;
  foreach my $d (&every_data) {
    $exists = 1, last if ($newname eq $paths{$d}->get('lab'));
  };
  Error("There is already a data set named \"$newname\"!"), return if $exists;
  project_state(0);
  push @rename_buffer, $newname;
  $paths{$this} -> make(lab=>$newname);
  $list -> itemConfigure($this, 0, -text=>$newname);
};


sub toggle_data {
  my $data = $_[0];
  my $style = ($paths{$data}->get('include')) ? $list_styles{enabled} : $list_styles{disabled};
  $list -> entryconfigure($data, -style => $style);
  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next unless $paths{$p}->type;
  SWITCH: {
      ($paths{$p}->type =~ /(bkg|data|fit|res)/) and do {
	last SWITCH unless ($paths{$p}->get('sameas') eq $data);
	last SWITCH unless $list->infoExists($paths{$p}->get('id'));
	my $style = ($paths{$data}->get('include')) ? $list_styles{enabled} : $list_styles{disabled};
	$list -> entryconfigure($paths{$p}->get('id'), -style => $style);
	last SWITCH;
      };
      ($paths{$p}->type eq 'feff') and do {
	last SWITCH unless ($paths{$p}->data eq $data);
	my $style = ($paths{$data}->get('include')) ? $list_styles{noplot} : $list_styles{noplotdis};
	$list -> entryconfigure($paths{$p}->get('id'), -style => $style);
	last SWITCH;
      };
      ($paths{$p}->type eq 'path') and do {
	last SWITCH unless ($paths{$p}->data eq $data);
	my $style = $list_styles{$paths{$data}->pathstate("enabled")};
	$style = $list_styles{$paths{$data}->pathstate("disabled")} if (not $paths{$data}->get('include'));
	$style = $list_styles{$paths{$data}->pathstate("disabled")} if ($paths{$data}->get('include') and
								       not $paths{$p}->get('include'));
	$list -> entryconfigure($paths{$p}->get('id'), -style => $style);
	last SWITCH;
      };
    };
  };
  if ($paths{$current}->type =~ /(bkg|data|diff|fit|res)/) {
    my @all = &every_data;
    $widgets{op_do_bkg} -> configure(-state=>($#all) ? 'disabled' : 'normal' );
    ##$widgets{op_use_bkg} -> configure(-state=>($#all) ? 'disabled' : 'normal' );
  };
  project_state(0);
};


sub make_difference_spectrum {
  my $this = $paths{$current}->data;
  unless (-e $paths{$this}->get('file')) {
    Error("You have not yet imported this data file.");
    return;
  };
  unless ($list->info(exists=>$paths{$this}->get('id').'.0')) {
    Error("You have not yet done a fit.  You cannot yet make a difference spectrum.");
    return;
  };

  my @paths = grep {(ref($paths{$_}) =~ /Ifeffit/) and
		      ($paths{$_}->type eq 'path')} $list->info('selection');
  Error("You did not select any paths.  The difference spectrum is computed from the set of highlighted paths."),
    return unless @paths;
  $top -> Busy;
  my $not_from_this = 0;
  foreach (@paths) {
    ++$not_from_this if ($paths{$_}->data ne $this);
  };
  if ($not_from_this) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "You have selected paths not associated with the current data set.  Do you want to continue making the difference spectrum?",
		     -title          => 'Athena: Question...',
		     -buttons        => [qw/Yes No/],
		     -default_button => 'No',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    if ($response eq 'No') {
      Echo("Difference spectrum aborted");
      $top -> Unbusy;
      return;
    };
  };

  my $explanation = "Difference between " . $paths{$this}->descriptor() .
    " and these paths:\n";
  my $string = "## Making difference spectrum from data ";
  $string   .= $paths{$this}->descriptor() . $/;
  $paths{$this} -> make(diff_paths=>[], diff_list=>[], diff_mapping=>[]);
  foreach my $p (sort {(split(/\./,$a))[0] cmp (split(/\./,$b))[0]
			 or
		       (split(/\./,$a))[1] cmp (split(/\./,$b))[1]
			 or
		       (split(/\./,$a))[2] <=> (split(/\./,$b))[2]
		     } @paths) { # make sure they are in order
    next unless ($paths{$p}->get('include'));  # skip paths deselected for fit
    my $ind    = $paths{$p}->index;
    my $data   = $paths{$p}->data;
    my $pathto = $paths{$p}->get('path');
    ## need to keep track of which paths went into this diff spectrum
    ## so they can be deselected for a fit to the diff spectrum
    push @{$paths{$data}->{diff_paths}}, $p;
    push @{$paths{$data}->{diff_list}}, $ind;
    $paths{$data}->{diff_mapping}->[$ind] = $p;
    $string   .= $paths{$p} -> write_path($ind, $pathto, $config{paths}{extpp}, $stash_dir);
    $explanation .= ".\t" . $paths{$p}->descriptor() . $/;
  };

  ## do an ff2chi on the selected paths
  my $group = $paths{$this}->get('group');
  $string .= $paths{$this} ->
    write_ff2chi( &normalize_paths($paths{$this}->{diff_list}), $group."_sum" );

  ## make the difference spectrum
  $string .= "set ${group}_diff.k   = $group.k\n";
  if ((lc($paths{$this}->get('do_bkg')) eq 'yes') or $paths{$this}->get('use_bkg')) {
    $string .= "set ${group}_diff.chi = $group.chi - ${group}_sum.chi - ${group}_bkg.chi\n";
  } else {
    $string .= "set ${group}_diff.chi = $group.chi - ${group}_sum.chi\n";
  };

  ## get the filename to save this diff spectrum to
  my $types = [['chi Files', '*.chi'],
	       ['All Files', '*'],];
  my $path = File::Spec->catfile($project_folder, "chi_data", "");
  my $fname = basename($paths{$this}->get('file'));
  my @list = split(/\./, $fname);
  $fname = $list[0] . "_diff." . $list[1];
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 #(not $is_windows) ?
				 #  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialdir=>$path,
				 -initialfile=>$fname,
				 -title => "Artemis: Save difference spectrum");
  $top -> Unbusy, return unless $file;
  ## fetch the titles for this data
  my $titles = $widgets{op_titles}->get(qw(1.0 end));
  my $n = 1;
  foreach my $e (split(/\n/, $explanation)) {
    $string .= "\$artemis_title$n = \"$e\"\n";
    ++$n;
  };
  foreach my $t (split(/\n/,$titles)) {
    next if ($t =~ /^\s*$/);
    $string .= "\$artemis_title$n = \"$t\"\n";
    ++$n;
  };
  $string .= "\$artemis_title$n = \"artemis: " . $paths{$this}->get('lab') . " as background subtracted chi(k)\"\n";
  ## write and erase the difference data
  $string .= "write_data(file=$file,\n" .
    wrap("           ", "           ", "\$artemis_title*, ${group}_diff.k, ${group}_diff.chi)");
  $string .= "\n";
  $string .= "erase \@group ${group}_diff\n";
  $paths{$this} -> dispose($string, $dmode);

  ## offer to reload the bkg sub data
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Would you like to replace the current data set with the difference spectrum?",
		   -title          => 'Athena: Replace data?',
		   -buttons        => [qw/Yes No/],
		   -default_button => 'Yes',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  if ($dialog->Show() eq 'Yes') {
    $paths{$this}->make(do_bkg=>'no');
    &read_data($paths{$current}->data, $file, 1);
    ## need to uninclude the paths that went into the diff spectrum
    foreach my $p (@paths) {
      &select_paths('toggle', $p, 1)
    };
  };
  $top -> Unbusy;
  Echo("Saved difference spectrum to $file");
};




sub delete_data {
  my $data = $paths{$current}->data;
  my $label = $paths{$data}->get('lab');

  Error("You cannot discard the first data set.  Try changing the data via the \"Open data file\" in the Data menu."),
    return if ($data eq 'data0');
  my $dialog =
    $top -> Dialog(-bitmap         => 'questhead',
		   -text           => "Are you sure you want to discard \"$label\" and all it's paths?",
		   -title          => 'Artemis: Verifying...',
		   -buttons        => [qw/Discard Cancel/],
		   -default_button => 'Discard',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $response = $dialog->Show();
  Echo("Not discarding \"$label\""), return unless ($response eq 'Discard');
  Echo("Discarding \"$label\" and all its paths ... ");

  ## discard titles for this data group
  $paths{$data}->delete_titles;

  my $first = &first_data;
  ($first = 'data0') if ($first eq $data);
  $paths{$first}->make(include=>1), &toggle_data($first) unless $paths{$first}->included;
  display_page($first);

  $list -> delete('offsprings', $data);
  $list -> delete('entry',      $data);
  my (@delete_em, @rmtree);
  foreach my $k (keys %paths) {
    #print $k, $/;
    #next unless exists($paths{$k});
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless $paths{$k}->type;
    ##     push(@delete_em, $k) if ($k eq $data);
    ##     push(@rmtree, $k) if (($paths{$k}->type eq 'feff') and ($k =~ /^$data/));
    push(@delete_em, $k) if ($paths{$k}->data eq $data);
    ##     if (exists $paths{$k}->{data}) {
    ##       push(@delete_em, $k) if ($paths{$k}->data eq $data);
    ##     };
    ##     if (exists $paths{$k}->{sameas}) {
    ##       push(@delete_em, $k) if ($paths{$k}->{sameas} eq $data);
    ##     };
  };
  map { delete $paths{$_} } @delete_em;
  map { rmtree(File::Spec->catfile($project_folder, $_)) } @rmtree;

  ## deactivate these two checkbuttons if we now have only one active
  ## data set
  my $n = 0; map {++$n} (&all_data);
  if ($n == 1) {
    $widgets{op_include} -> configure(-state=>'disabled');
    $widgets{op_plot}    -> configure(-state=>'disabled');
  };

  ## is at least one data set included in the fit?
  my $ok = 0;
  foreach my $d (&all_data) {
    $ok++ if $paths{$d}->get('include');
  };
  ## if not, turn on data0
  unless ($ok) {
    $paths{data0}->make(include=>1);
    toggle_data('data0');
    #foreach my $p (keys %paths) {
    #  next unless ($paths{$p}->get('parent') eq 'data0');
    #  next unless ($paths{$p}->type eq 'feff');
    #  $paths{$p}->make(include=>1);
    #};
  };

  Echo("Discarding \"$label\" and all its paths ... done!");
};

sub nidp {
  Error("You have not opened a data file yet."), return unless $paths{&first_data}->get('file');
  my ($nidp, $ndat) = (0, 0);
  foreach my $k (keys %paths) {
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    next unless ($paths{$k}->type eq 'data');
    next unless ($paths{$k}->{include});
    my $deltak = $paths{$k}->get('kmax') - $paths{$k}->get('kmin');
    my $deltar = $paths{$k}->get('rmax') - $paths{$k}->get('rmin');
    $nidp     += int( 2 * $deltak * $deltar / PI );
    ++$ndat;
  };
  ($nidp = 0) if ($nidp < 0);
  my $nvar = 0;
  foreach (@gds) {
    ++$nvar if ($_->type eq 'guess');
  };
  my $message = "$nidp independent points data points (Nyquist): ($ndat data set";
  $message .= ($ndat > 1) ? "s)" : ")";
  $message .= "  ($nvar variable";
  $message .= ($nvar > 1) ? "s)" : ")";
  $props{'Information content'} = $message;
  Echo($message);
};


sub fetch_epsilon_k {
  Error("You have not opened a data file yet."), return unless $paths{&first_data}->get('file');
  my $this  = $paths{$current}->data;
  my $lab   = $paths{$this}->descriptor;
  my @noise = $paths{$this}->chi_noise;
  Echo(sprintf("The noise in k for \"$lab\" is %.7f and in R is %.7f", @noise));
};


## this currently only works on the most recent fit -- need to
## generalize to all fits...
sub running_r_factor {
  Error("You have not opened a data file yet."), return unless $paths{&first_data}->get('file');
  my $space = $_[0];

  ## presumably, the current is a fit and not the head of the branch
  my $this  = $paths{$current}->data;

  my (@x, @y, $max_y);


  ## before doing this, shift anchor from head of fit branch to latest
  my $data = $paths{$current}->data;
  my $which = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');
  display_page($which);
  $top -> update;

  ## plot the data and fit for this data set
  my $group = $paths{$this}->get('group');
  $list -> selectionSet($this);
  &plot($space, 0);

  ## compute the running r-factor in the appropriate space
  my ($datasum, $diffsum, $ndata) = (0, 0, 0);
  if (lc($space) eq 'k') {
    my $kw  = $plot_features{kweight};
    my @k   = Ifeffit::get_array($group.".k");
    my @chi = Ifeffit::get_array($group.".chi");
    unless ($paths{$current}->get('imported')) {
      ## read this fit into its group if it has not already been imported
      my $command = "read_data(file=\"" .
	$paths{$current}->get('fitfile') .
	  "\",\n" .
	    "          type=chi, group=". $paths{$current}->get('group') . ")\n";
      $paths{$current}->dispose($command, $dmode);
      $paths{$current}->make(imported=>1);
    };
    my @fit = Ifeffit::get_array($paths{$current}->get('group').".chi");
    foreach (0 .. $#k) {
      if ($k[$_] < $paths{$this}->get('kmin')) {
	push @x, 0;
	push @y, 0;
	next;
      };
      last if ($k[$_] > $paths{$this}->get('kmax'));
      ##$datasum += $chi[$_]**2;
      $diffsum += ($chi[$_]*$k[$_]**$kw - $fit[$_]*$k[$_]**$kw)**2;
      push @x,  $k[$_];
      push @y, $diffsum;
      ##++$ndata;
    };
    $paths{$this} -> dispose("___x = ceil($group.chi*$group.k^$kw)", 1);
    $max_y = Ifeffit::get_scalar("___x");
  } elsif (lc($space) eq 'r') {
    my @r    = Ifeffit::get_array($group.".r");
    my @chi  = Ifeffit::get_array($group.".chir_re");
    my @chi2 = Ifeffit::get_array($group.".chir_im");
    unless ($paths{$current}->get('imported')) {
      ## read this fit into its group if it has not already been imported
      my $command = "read_data(file=\"" .
	$paths{$current}->get('fitfile') .
	  "\",\n" .
	    "          type=chi, group=". $paths{$current}->get('group') . ")\n";
      $paths{$current}->dispose($command, $dmode);
      $paths{$current}->make(imported=>1);
    };
    $paths{$current}->dispose($paths{$current}->write_fft(0,$config{data}{rmax_out}), $dmode);
    my @fit  = Ifeffit::get_array($paths{$current}->get('group').".chir_re");
    my @fit2 = Ifeffit::get_array($paths{$current}->get('group').".chir_im");
    my $rmin = $paths{$this}->get('rmin');
    ($rmin = 0) if (lc($paths{$this}->get('do_bkg')) eq 'yes');
    foreach (0 .. $#r) {
      if ($r[$_] < $rmin) {
	push @x, 0;
	push @y, 0;
	next;
      };
      last if ($r[$_] > $paths{$this}->get('rmax'));
      ##$datasum += $chi[$_]**2 + $chi2[$_]**2;
      $diffsum += ($chi[$_]-$fit[$_])**2 + ($chi2[$_]-$fit2[$_])**2;
      push @x, $r[$_];
      push @y, $diffsum;
      ##++$ndata;
    };
    $paths{$this} -> dispose("set ___x = ceil($group.chir_mag)", 1);
    $max_y = Ifeffit::get_scalar("___x");
  } elsif (lc($space) eq 'q') {
    my @q    = Ifeffit::get_array($group.".q");
    my @chi  = Ifeffit::get_array($group.".chiq_re");
    my @chi2 = Ifeffit::get_array($group.".chiq_im");
    unless ($paths{$current}->get('imported')) {
      ## read this fit into its group if it has not already been imported
      my $command = "read_data(file=\"" .
	$paths{$current}->get('fitfile') .
	  "\",\n" .
	    "          type=chi, group=". $paths{$current}->get('group') . ")\n";
      $paths{$current}->dispose($command, $dmode);
      $paths{$current}->make(imported=>1);
    };
    $paths{$current}->dispose($paths{$current}->write_fft(0,$config{data}{rmax_out}), $dmode);
    $paths{$current}->dispose($paths{$current}->write_bft, $dmode);
    my @fit  = Ifeffit::get_array($paths{$current}->get('group').".chiq_re");
    my @fit2 = Ifeffit::get_array($paths{$current}->get('group').".chiq_im");
    foreach (0 .. $#q) {
      if ($q[$_] < $paths{$this}->get('kmin')) {
	push @q, 0;
	push @y, 0;
	next;
      };
      last if ($q[$_] > $paths{$this}->get('kmax'));
      ##$datasum += $chi[$_]**2 + $chi2[$_]**2;
      $diffsum += ($chi[$_]-$fit[$_])**2 + ($chi2[$_]-$fit2[$_])**2;
      push @x, $q[$_];
      push @y, $diffsum;
      ##++$ndata;
    };
    $paths{$this} -> dispose("___x = ceil($group.chiq_mag)", 1);
    $max_y = Ifeffit::get_scalar("___x");
  };

  ## normalize the running r-factor to the data
  my $scale = $max_y / $y[$#y];
  foreach my $i (0 .. $#y) {
    $y[$i] *= $scale;
  };

  ## load the arrays into ifeffit
  Ifeffit::put_array('r___unning.x', \@x);
  Ifeffit::put_array('r___unning.y', \@y);

  my $color = ($plot_features{win}) ? 'c3' : 'c2';
  ## plot the running r-factor over the data+fit
  my $message = "r___unning.x, r___unning.y, key=\"running R-factor\", ";
  $message   .= "color=$config{plot}{$color}, style=lines, ";
  $message   .= "title=\"Running R-factor, " . $paths{$this}->get('lab') . ", and fit\")";
  $message    = wrap("plot(", "     ", $message);
  $paths{$this}->dispose($message, $dmode);

};


sub verify_data_parameters {
  my $message = "";
  foreach my $d (&all_data) {

    $message .= $paths{$d}->get('lab') . ": kmin is greater than kmax\n"
      if ($paths{$d}->get('kmin') > $paths{$d}->get('kmax'));

    $message .= $paths{$d}->get('lab') . ": kmax is zero\n"
      if ($paths{$d}->get('kmax') < EPSILON);

    $message .= $paths{$d}->get('lab') . ": rmin is greater than rmax\n"
      if ($paths{$d}->get('rmin') > $paths{$d}->get('rmax'));

    $message .= $paths{$d}->get('lab') . ": rmax is zero\n"
      if ($paths{$d}->get('rmax') < EPSILON);

  };
  return $message;
};

sub verify_reffs {
  my $message = "";
  foreach my $d (&all_data) {
    my $this_rmax = $paths{$d}->get('rmax');
    my $this_ok = 1;
    foreach my $p (&path_list) {
      next unless (ref($paths{$p}) =~ /Ifeffit/);
      next unless ($paths{$p}->type eq 'path');
      next unless ($paths{$p}->get('data') eq $d);
      next unless ($paths{$p}->get('include'));
      if ( $paths{$p}->get('reff') > $this_rmax*$config{warnings}{reff_margin} ) {
	$message .= "\t" . $paths{$p}->descriptor . "\n";
	$this_ok = 0;
      };
    };
    unless ($this_ok) {
      $message  = "Artemis found one or more paths that are far outside the fitting range:\n" . $message;
      $message .= "Check the R-range of data set \"" . $paths{$d}->descriptor . "\"\n\n";
    };
  };
  return $message;
};

sub verify_rmin_rbkg {
  my $message = "";
  foreach my $d (&all_data) {
    my $this_rmin = $paths{$d}->get('rmin');
    my $this_rbkg = $paths{$d}->get('bkg_rbkg');
    next unless $this_rbkg;
    if ($this_rmin < $this_rbkg) {
      $message .= "\nThe value of rmin for \"" . $paths{$d}->descriptor . "\" is smaller than the value of\n";
      $message .= "Rbkg used during background removal in Athena.\n";
      $message .= "     rmin = $this_rmin        Rbkg = $this_rbkg\n";
    };
  };
  if ($message) {
    $message .= "\nLetting rmin be smaller than Rbkg is dangerous in that it masks important\n";
    $message .= "correlations between the data and the background.\n\n";
  };
  return $message;
};

##  END OF THE DATA SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##
## THE PALETTES SUBSECTION

sub display_file {
  my ($type, $fname) = @_;
  Echo("No feff calculation!"), return if (($type eq 'path') and ($n_feff == 0));
 SWITCH: {
    last SWITCH if ($type =~ /^\s*$/);
    $fname = $paths{$current}->get($fname),         last SWITCH if  ($type eq 'feff') ;
    $fname = File::Spec->catfile($paths{$current}->get('path'),
				 $paths{$current}->get('feff')),
				                    last SWITCH if (($type eq 'path') and
								    ($fname eq 'this'));
    $fname = File::Spec->catfile($paths{$current}->get('path'), $fname),
				                    last SWITCH if ($type eq 'path');
    ## dereference the group that a fit or bkg is the same as
    $fname = $paths{$current}->get('file'),
                                                    last SWITCH if (($type eq 'data') and
								    ($fname eq 'this') and
								    $paths{$current}->get('sameas'));
    ## dereference the group that a path or feff refers to
    $fname = $paths{$current}->get('file'),
                                                    last SWITCH if (($type eq 'data') and
								    ($fname eq 'this') and
								    ($current =~ /feff\d+/));
    $fname = $paths{$current}->get('file'),         last SWITCH if (($type eq 'data') and
								    ($fname eq 'this'));
    Echo("Want to display $fname"), return unless ($type eq 'file');
  };
  ## paths file, deal with feff6 vs. feff8!!
  ($fname = substr($fname, 0, -9)."path00.dat") if (($fname =~ /paths\.dat$/) and (not -e $fname));
  Echo("You have not read any data yet"), return unless (defined $fname);
  Echo("The file you asked for could not be found"), return unless (-e $fname);
  Echo("Displaying $fname");
  $current_file = $fname;
  $notes{files} -> delete(qw(1.0 end));

  my $was_mac = $paths{data0} ->
    fix_mac($fname, $stash_dir, lc($config{general}{mac_eol}), $top);
  return, Echo("\"$fname\" had Macintosh EOL characters and was skipped.") if ($was_mac eq "-1");
  if ($was_mac !~ m{^(?:0|-?1)}) {
    Echo("\"$fname\" had Macintosh EOL characters and was fixed.");
    $fname = $was_mac;
  };

  Echo("Could not find \"$fname\""), return unless (-e $fname);
  open F, "$fname" or die "Could not open $fname for viewing.\n";
  while (<F>) {
    $_ =~ s{\r}{}g if not $is_windows;
    $notes{files} -> insert('end', $_);
  };
  close F;
  $notes{files} -> yviewMoveto(0);
  $top      -> update;
  raise_palette('files');
};

sub show_things {
  if ($_[0] eq 'paths') {
    my $error = "";
    $error   .= &verify_parens;
    if ($error) {
      post_message($error, "Error Messages");
      Error("cannot show paths due to errors in parameters and math expressions");
      return;
    };
  };
  $paths{data0}->dispose("show \@$_[0]", $dmode);
  $top -> update();
  raise_palette('ifeffit');
};

sub show_defs {
  my $which = &which_set_path;
  if ($which) {
    $paths{data0}->dispose("\n## Evaluating def parameters using " . $paths{$which}->descriptor(), $dmode);
    $paths{data0}->dispose("set path_index=" . $paths{$which}->get('fit_index'), $dmode);
  };
  my %seen;
  my @defs;
  foreach my $p (@gds) {
    push @defs, $p->name if ($p->type eq 'def');
  };
  $paths{data0}->dispose("show " . join(" ", @defs), $dmode);
  $top -> update();
  raise_palette('ifeffit');
};



## $pal     : key for %notes hash
## $init    : value for -initialfile
## $title   : value for -title
## $t       : anon array of values for $types list
## $prepend : text string to prepend to contents of $notes{$pal}
## $append  : text string to append to contents of $notes{$pal}
sub save_from_palette {
  my ($pal, $init, $title, $t, $prepend, $append) = @_;
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;
  my $path = $current_data_dir || cwd;
  ##$path = File::Spec->catfile($project_folder, "log_files") if ($pal  eq 'results');
  ##$path = File::Spec->catfile($project_folder, "log_files") if ($pal  =~ /report/);
  ##$path = File::Spec->catfile($project_folder, "log_files") if ($init =~ /report/);
  my $types = ($t) ? [$t, ['All Files', '*']] : [['All Files', '*'], ['Input Files', '*.inp']];
  ($init =~ s/[\\:\/\*\?\'<>\|]/_/g);# if ($is_windows);
  my $file = $top -> getSaveFile(-filetypes=>$types,
				 ##(not $is_windows) ?
				 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				 -initialfile=>$init||$generic_name,
				 -initialdir=>$path,
				 -title => $title);
  return unless ($file);
  my ($name, $pth, $suffix) = fileparse($file);
  #if ($pal eq 'results') {
  #  project_state(0) if sub_directory($pth, $project_folder);
  #} else {
    $current_data_dir = $pth;
  #};
  open F, ">".$file or do {
    Error("You cannot write to \"$file\"."); return
  };
  print F $prepend, $notes{$pal}->get(qw(1.0 end)), $append;
  close F;

  $generic_name = "artemis.stuff";
  Echo("Saved contents of $pal palette to $file");
};




## post a text message to the "messages" palette
## args:  0:text of message  1:id string  2:hide palette
sub post_message {
  $notes{messages} -> delete(qw(1.0 end));
  $notes{messages} -> insert('end', $_[0]||"");
  $notes{messages} -> yviewMoveto(0);
  ##$current_file = $_[1] || "";
  $top -> update;
  raise_palette('messages') unless $_[2];
};


sub raise_palette {
  ##($update->state() eq "normal") ?
  $update->deiconify;
  $update->raise;
  $notebook->raise($_[0]);
};


sub write_results_header {
  my ($fh, $r_fit) = @_;
  foreach ('Project title', 'Comment', 'Prepared by', 'Contact', 'Started', 'Last fit', 'Environment') {
    my $this = $_;
    ($this = "This fit at") if ($this eq 'Last fit');
    print $fh sprintf("%-15s :  ", $this);
    print($fh "\n"), next if (not defined($props{$_}));
    print($fh "\n"), next if ($props{$_} =~ /^\<.*\>$/);
    print($fh "\n"), next if ($props{$_} =~ /^\s*$/);
    print $fh "$props{$_}\n";
  };
  my $string = q{};
  foreach my $d (&all_data) {
    $string .= '"' . $paths{$d}->get('lab') . '", ';
  };
  chop $string; chop $string;
  print $fh sprintf("%-15s :  %s\n", "Data sets", $string);
  print $fh sprintf("%-15s :  %s\n", "Fit label",       $$r_fit{label});
  print $fh sprintf("%-15s :  %s\n", "Figure of merit", $$r_fit{fom});
  print $fh "\n" . "=" x 60 . "\n\n";
};

sub write_results {
  my ($fh, $how, $how_many) = @_;  ## how=1 means fit, how=2 means summation
  ## compile a list of parameters in a sensible order
  my %seen;			# see The Perl Cookbook, 4.6, p. 102,
                                # need to weed out repeated params
  my @all = grep { $_->{name} } @gds;
  my (@params, @defs, @sets, @restraints, @afters);
  foreach my $p (@gds) {
    push @params,     lc($p->name) if ($p->type eq 'guess');
    push @defs,       lc($p->name) if ($p->type eq 'def');
    push @sets,       lc($p->name) if ($p->type eq 'set');
    push @restraints, lc($p->name) if ($p->type eq 'restrain');
    push @afters,     lc($p->name) if ($p->type eq 'after');
  };
  $paths{data0}->dispose("show \@variables", 1);
  my ($lines, $response) = (Ifeffit::get_scalar('&echo_lines'), "");
  my @bkg;
  foreach my $i (1 .. $lines) {
    my $this = (split(" ", Ifeffit::get_echo()))[0];
    push @bkg, $this if ($this =~ /^bkg\d\d_\d\d$/);
  };

  my @things = ('n_idp n_varys chi_square chi_reduced r_factor epsilon_k epsilon_r',
		@params, @defs, @bkg);
  my %things = ("n_idp"       => "Independent points          ",
		"n_varys"     => "Number of variables         ",
		"chi_square"  => "Chi-square                  ",
		"chi_reduced" => "Reduced Chi-square          ",
		"r_factor"    => "R-factor                    ",
		"epsilon_k"   => "Measurement uncertainty (k) ",
		"epsilon_r"   => "Measurement uncertainty (R) ",
		"data_total"  => "Number of data sets         ",
	       );
  if ($how == 1) {
    $paths{data0}->dispose("show n_idp n_varys chi_square chi_reduced r_factor epsilon_k epsilon_r data_total\n", 1);
    ($lines, $response) = (Ifeffit::get_scalar('&echo_lines'), "");
    map {$response .= Ifeffit::get_echo()."\n"} (1 .. $lines);
    foreach my $k (keys %things) {
      $response =~ s/($k)\s+/$things{$k}/eg;
    };
  } else {
    my $this = $paths{$paths{$current}->data}->descriptor();
    $response .= sprintf("%-70s\n", "!! FITTING WAS NOT PERFORMED.");
    $response .= sprintf("%-70s",   "!!   Summation performed for data set \"$this\" using $how_many paths.");
  };
  print $fh $response."\n";

  $response = "";
  if (@Ifeffit::Tools::buffer) {
    print $fh "!!                                                              \n";
    print $fh "!! WARNING.  The following variables had no effect on the fit:  \n";
    map {push @bad_params, $_; printf $fh "!!  >> %-58s\n", $_} @Ifeffit::Tools::buffer;
    print $fh "!!                                                              \n";
    print $fh "!! Uncertainties could not be estimated.                        \n";
    print $fh "!!                                                              \n";
  };
  print $fh "\nGuess parameters +/- uncertainties  (initial guess):\n";
  foreach my $p (@gds) {
    next unless ($p->{type} eq 'guess');
    my $string;
				## this variable had no effect on the fit ...
    if (grep {/$p/} @Ifeffit::Tools::buffer) {
				## ... and was guessed as a math expr.
      if ($p->{mathexp} !~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) {
	$string = sprintf("  %-15s =  %12.7f : no effect on the fit  (guessed as %s)\n",
			  $p->name,
			  $p->bestfit,
			  $p->mathexp);
				## ... and was guessed as a number
      } else {
	$string = sprintf("  %-15s =  %12.7f : no effect on the fit  (%.4g)\n",
			  $p->name,
			  $p->bestfit,
			  $p->mathexp);
      };
				## this variable was guessed as a math expr.
    } elsif ($p->{mathexp} !~ /^\s*-?(\d+\.?\d*|\.\d+)\s*$/) {
      $string = sprintf("  %-15s =  %12.7f   +/-   %12.7f    (guessed as %s)\n",
			$p->name,
			$p->bestfit,
			$p->error,
			$p->mathexp);
    } else {			## this variable was guessed as a number
      $string = sprintf("  %-15s =  %12.7f   +/-   %12.7f    (%.4f)\n",
			$p->name,
			$p->bestfit,
			$p->error,
			$p->mathexp);
    };
    print $fh $string;
  };
  if (@defs) {
    print $fh "\nDef parameters";
    my $which = &which_set_path;
    print $fh " (using \"" . $paths{$which}->descriptor() . "\")"
      if ($which);
    print $fh ":\n";
  };
  foreach (@gds) {
    next unless ($_->{type} eq 'def');
    my $string = sprintf("  %-15s =  %12.7f\n",
			 $_->{name},
			 $_->{bestfit});
    print $fh $string;
  };
  @restraints and print $fh "\nRestraints:\n";
  foreach (@gds) {
    next unless ($_->{type} eq 'restrain');
    my $string = sprintf("  %-15s =  %12.7f  :=  %s \n",
			 $_->name,
			 $_->bestfit,
			 $_->mathexp);
    print $fh $string;
  };
  @sets and print $fh "\nSet parameters:\n";
  foreach (@gds) {
    next unless ($_->{type} eq 'set');
    my $string = sprintf("  %-15s =  %s\n",
			 $_->name,
			 $_->mathexp);
    print $fh $string;
  };
  @afters and print $fh "\nAfter-fit parameters:\n";
  foreach (@gds) {
    next unless ($_->{type} eq 'after');
    my $string = sprintf("  %-15s : %12.7f = %s\n",
			 $_->name,
			 $_->bestfit,
			 $_->mathexp);
    print $fh $string;
  };
  @bkg and print $fh "\nBackground parameters +/- uncertainties:\n";
  foreach (@bkg) {
    my $string = sprintf "  %-15s =  %12.7f   +/-   %12.7f\n", $_,
      Ifeffit::get_scalar($_), Ifeffit::get_scalar("delta_$_");
    print $fh $string;
  };
  my $first = &first_data;
};


sub write_opparams {
  my ($fh, $d) = @_;
  my @lines = ();
  push @lines, sprintf("file: %s", $paths{$d}->get('file'));
  push @lines, "title lines:";
  foreach my $t (split(/\n/, $paths{$d}->get('titles'))) { push @lines, "  ".$t; };
  push @lines, "";
  push @lines, sprintf("k-range             = %.3f - %.3f", $paths{$d}->get('kmin'), $paths{$d}->get('kmax'));
  push @lines, sprintf("dk                  = %.3f", $paths{$d}->get('dk'));
  push @lines, sprintf("k-window            = %s", $paths{$d}->get('kwindow'));
  my @kw = ();
  push @kw, 1 if $paths{$d}->get('k1');
  push @kw, 2 if $paths{$d}->get('k2');
  push @kw, 3 if $paths{$d}->get('k3');
  push @kw, 1 unless @kw;
  push @kw, $paths{$d}->{karb} if $paths{$d}->get('karb');
  push @lines, sprintf("k-weight            = %s", join(",", @kw));
  push @lines, sprintf("R-range             = %.3f - %.3f", $paths{$d}->get('rmin'), $paths{$d}->get('rmax'));
  push @lines, sprintf("dR                  = %.3f", $paths{$d}->get('dr'));
  push @lines, sprintf("R-window            = %s", $paths{$d}->get('rwindow'));
  my $bkg = "none";
  ($bkg = "fitted spline") if ($paths{$d}->get('do_bkg') eq 'yes');
  ($bkg = "previous fit spline") if $paths{$d}->get('use_bkg');
  push @lines, sprintf("fitting space       = %s", $paths{$d}->get('fit_space'));
  push @lines, sprintf("background function = %s", $bkg);
  my $n_bkg_params = 0;
  if ($paths{$d}->get('do_bkg') eq 'yes') {
    $n_bkg_params = ($paths{$d}->get('kmax') - $paths{$d}->get('kmin') + $paths{$d}->get('dk'))
      * $paths{$d}->get('rmin')
	* 2 / PI;
    $n_bkg_params = round($n_bkg_params) + 1;
    push @lines, sprintf("spline parameters   = %d", $n_bkg_params);
  };
  if (lc($paths{$d}->get('pcpath')) eq 'none') {
    push @lines, "phase correction    = none";
  } else {
    push @lines, sprintf("phase correction    = %s", $paths{$paths{$d}->get('pcpath')}->descriptor());
  };
  push @lines, "fit the difference spectrum" if $paths{$d}->get('fit_diff');
  push @lines, "\n";
  ## compute chi-square and R-factor for this data set and for all its k-weightings
  my (@datasum, @diffsum, $ndata) = ((), (), 0);
  if (lc($paths{$d}->get('fit_space')) eq 'k') {
    my @k   = Ifeffit::get_array($paths{$d}->get('group').".k");
    my @chi = Ifeffit::get_array($paths{$d}->get('group').".chi");
    my @fit = Ifeffit::get_array($paths{$d}->get('group')."_fit.chi");
    my $i = 0;
    foreach my $w ($paths{$d}->group_weights) {
      $datasum[$i] = 0;
      $ndata = 0;
      foreach (0 .. $#k) {
	next if ($k[$_] < $paths{$d}->get('kmin'));
	last if ($k[$_] > $paths{$d}->get('kmax'));
	$datasum[$i] += ($chi[$_]*$k[$_]**$w)**2;
	$diffsum[$i] += ($chi[$_]*$k[$_]**$w - $fit[$_]*$k[$_]**$w)**2;
	++$ndata;
      };
      ++$i;
    };
  } elsif (lc($paths{$d}->get('fit_space')) eq 'r') {
    my $i = 0;
    foreach my $w ($paths{$d}->group_weights) {
      ## bring fit up to date in R space for this k-weight
      $paths{$d}->dispose($paths{$d}->write_fft($w, $config{data}{rmax_out}), $dmode);
      $paths{$d.".0"}->dispose($paths{$d.".0"}->write_fft($w, $config{data}{rmax_out}), $dmode);
      my @r    = Ifeffit::get_array($paths{$d}->get('group').".r");
      my @chi  = Ifeffit::get_array($paths{$d}->get('group').".chir_re");
      my @chi2 = Ifeffit::get_array($paths{$d}->get('group').".chir_im");
      my @fit  = Ifeffit::get_array($paths{$d}->get('group')."_fit.chir_re");
      my @fit2 = Ifeffit::get_array($paths{$d}->get('group')."_fit.chir_im");
      my $rmin = $paths{$d}->get('rmin');
      ($rmin = 0) if (lc($paths{$d}->get('do_bkg')) eq 'yes');
      $datasum[$i] = 0;
      $ndata = 0;
      foreach (0 .. $#r) {
	next if ($r[$_] < $rmin);
	last if ($r[$_] > $paths{$d}->get('rmax'));
	$datasum[$i] += $chi[$_]**2 + $chi2[$_]**2;
	$diffsum[$i] += ($chi[$_]-$fit[$_])**2 + ($chi2[$_]-$fit2[$_])**2;
	++$ndata;
      };
      ++$i;
    };
  } elsif (lc($paths{$d}->get('fit_space')) eq 'q') {
    my $i = 0;
    foreach my $w ($paths{$d}->group_weights) {
      ## bring this group up to date in q space for this k-weight
      $paths{$d}->dispose($paths{$d}->write_fft($w, $config{data}{rmax_out}), $dmode);
      $paths{$d}->dispose($paths{$d}->write_bft(), $dmode);
      $paths{$d.".0"}->dispose($paths{$d.".0"}->write_fft($w, $config{data}{rmax_out}), $dmode);
      $paths{$d.".0"}->dispose($paths{$d.".0"}->write_bft(), $dmode);
      my @q    = Ifeffit::get_array($paths{$d}->get('group').".q");
      my @chi  = Ifeffit::get_array($paths{$d}->get('group').".chiq_re");
      my @chi2 = Ifeffit::get_array($paths{$d}->get('group').".chiq_im");
      my @fit  = Ifeffit::get_array($paths{$d}->get('group')."_fit.chiq_re");
      my @fit2 = Ifeffit::get_array($paths{$d}->get('group')."_fit.chiq_im");
      foreach (0 .. $#q) {
	next if ($q[$_] < $paths{$d}->get('kmin'));
	last if ($q[$_] > $paths{$d}->get('kmax'));
	$datasum[$i] += $chi[$_]**2 + $chi2[$_]**2;
	$diffsum[$i] += ($chi[$_]-$fit[$_])**2 + ($chi2[$_]-$fit2[$_])**2;
	++$ndata;
      };
      ++$i;
    };
  };
  if (-e $paths{$d}->get('file')) {
    my $rfactor = 0;
    $rfactor   += $diffsum[$_]/$datasum[$_] foreach (0 .. $#diffsum);
    $rfactor   /= ($#diffsum+1);
    my @noise   = $paths{$d}->chi_noise;
    my $epsilon = (lc($paths{$d}->get('fit_space')) eq 'r') ? $noise[1] : $noise[0];
    my $nidp    = Ifeffit::get_scalar("n_idp");
    #print join(" ", $rfactor, @noise, $epsilon, $nidp, $ndata, $/);
    my $chisqr  = 0;
    $chisqr    += ($nidp*$diffsum[$_]) / ($ndata*$epsilon**2) foreach (0 .. $#diffsum);
    #push @lines, "These are not yet computed quite right in all situations...";
    #push @lines, sprintf("Chi-square for this data set = %.5f", $chisqr);
    push @lines, sprintf("R-factor for this data set   = %.5f", $rfactor);
    if ($#diffsum) {
      my $i = 0;
      foreach my $w ($paths{$d}->group_weights) {
	push @lines, sprintf("R-factor with k-weight=$w for this data set = %.5f", $diffsum[$i]/$datasum[$i]);
	++$i;
      };
    };
  };

  foreach my $l (@lines) {
    print $fh "  $l\n";
  };


};


## in the case of a log file for a summation, only write out those
## paths included in the sum
sub write_paths {
  my ($fh, $d, $how, $how_many, $rhash) = @_;
  my @included =  @{$paths{$d}->get('included')};
  my @inc_mapping = @{$paths{$d}->get('inc_mapping')};

  my $warnings = "";
  my %pathtext;
  my %pp = (reff=>0, dr=>0);
  my $pp_re = "(3rd|4th|d(egen|phase|r)|e[0i]|n.s02|r(|eff)|s(02|s2))";
  foreach my $i (@included) {
    next if (($how == 2) and
	     ($how_many =~ /sel/) and
	     (not exists($$rhash{$inc_mapping[$i]})) );
    $pp{index} = $i;
    $pp{descriptor} = $paths{$inc_mapping[$i]}->descriptor();
    $paths{data0} -> dispose("show \@path $i", 1);
    my ($lines, $response) = (Ifeffit::get_scalar('&echo_lines')||0, "");
    my ($this, $text) = ("","");
    if ($lines) {
      foreach my $l (1 .. $lines) {
	$response = Ifeffit::get_echo()."\n";
	next unless $response;
	next if ($response =~ /\*\*\* correl:/);
	if ($response =~ /^PATH/) {
	  my $p = $inc_mapping[$i];
	  $text .= "\n  ^^^" . $paths{$p}->descriptor();
	  $text .= "\n";
	  ##$text .= ($paths{$p}->get('group')) ? " (ifeffit group = ".$paths{$p}->get('group').")\n" : "\n";
	} elsif ($response =~ /^\s*feff/){
	  $this = (split(/\s+=\s+/, $response))[1];
	PPMATCH1: {
	    ($pp{$1} = $5), last PPMATCH1 # OK value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH1 # bad value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\*+/);
	    ($pp{$1} = $5), last PPMATCH1 # OK value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH1 # bad value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\*+/);
	  };
	  $text .= "    ".$response;
	} else {
	PPMATCH3: {
	    ($pp{$1} = $5), last PPMATCH3 # OK value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH3 # bad value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\*+/);
	  };
	  $text .= $response;
	};
      };
    };
    $pathtext{$i} = [$this,$text];
    $warnings .= &check_path(\%pp);
    store_ppvalues($inc_mapping[$i], \%pp);
  };

  foreach my $t (@included) {
    next if (($how == 2) and
	     ($how_many =~ /sel/) and
	     (not exists($$rhash{$inc_mapping[$t]})) );
    foreach my $l (split(/\n/, $pathtext{$t}[1])) {
      if ($l =~ /^\s*\^\^\^/i) {
	$l =~ s/^\s*\^\^\^//;
	print $fh "  ";
	print $fh $l." ..\n";
      } elsif ($l =~ /^\s*feff/) {
	print $fh $l."\n";
      } elsif ($l =~ /s02\s*=/) {
	$l =~ s/n\*s/s/;
	$l =~ s/=/  =/ if $paths{data0}->vstr == 1.02005;
	print $fh "    ".$l."\n";
      } else {
	print $fh "    ".$l."\n";
      };
    };
  };
  return $warnings;
}

sub write_paths_pre_1_2_5 {
  my ($fh, $d, $how, $how_many, $rhash) = @_;
  my @included =  @{$paths{$d}->get('included')};
  my @inc_mapping = @{$paths{$d}->get('inc_mapping')};

  my $warnings = "";
  my %pathtext;
  my %pp = (reff=>0, dr=>0);
  my $pp_re = "(3rd|4th|d(egen|phase|r)|e[0i]|reff|s(02|s2))";
  foreach my $i (@included) {
    next if (($how == 2) and
	     ($how_many =~ /sel/) and
	     (not exists($$rhash{$inc_mapping[$i]})) );
    $pp{index} = $i;
    $pp{descriptor} = $paths{$inc_mapping[$i]}->descriptor();
    $paths{data0} -> dispose("show \@path $i", 1);
    my ($lines, $response) = (Ifeffit::get_scalar('&echo_lines')||0, "");
    my ($this, $text) = ("","");
    if ($lines) {
      foreach my $l (1 .. $lines) {
	$response = Ifeffit::get_echo()."\n";
	next unless $response;
	next if ($response =~ /\*\*\* correl:/);
	if ($response =~ /^PATH/) {
	  my $p = $inc_mapping[$i];
	  $text .= "\n  " . $paths{$p}->descriptor();
	  $text .= "\n";
	  ##$text .= ($paths{$p}->{group}) ? " (ifeffit group = ".$paths{$p}->get('group').")\n" : "\n";
	} elsif ($response =~ /^\s*feff/){
	  $this = (split(/\s+=\s+/, $response))[1];
	  $response =~ s/=/  =/g;
	PPMATCH1: {
	    ($pp{$1} = $4), last PPMATCH1 # OK value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH1 # bad value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\*+/);
	    ($pp{$1} = $4), last PPMATCH1 # OK value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH1 # bad value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\*+/);
	  };
	  $text .= "    ".$response;
	} else {
	  $response =~ s/=/  =/g; # align = signs with reff+dr line
	  $text .= "    ".$response;
	PPMATCH3: {
	    ($pp{$1} = $4), last PPMATCH3 # OK value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH3 # bad value, beginning of line
	      if ($response =~ /^\s*$pp_re\s+=\*+/);
	  };
	PPMATCH4: {
	    ($pp{$1} = $4), last PPMATCH4 # OK value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\s+(-?\d+\.\d+)/);
	    ($pp{$1} = "tilt"), last PPMATCH4 # bad value, end of line
	      if ($response =~ /,\s*$pp_re\s+=\*+/);
	  };
	  ## I know that reff is reported before dr...
	  if ($response =~ /^\s*dr\s+=\s+/) { # report net R
	    $text .= sprintf("    reff+dr =   %9.6f\n", $pp{reff}+$pp{dr});
	  };
	};
      };
    };
    $pathtext{$i} = [$this,$text];
    $warnings .= &check_path(\%pp);
  };

  foreach my $t (@included) {
    next if (($how == 2) and
	     ($how_many =~ /sel/) and
	     (not exists($$rhash{$inc_mapping[$t]})) );
    foreach my $l (split(/\n/, $pathtext{$t}[1])) {
      if ($l =~ /^FEFF/) {
	print $fh $l."\n", 'pathid';
      } else {
	print $fh $l."\n";
      };
    };
  };
  return $warnings;
};


sub check_path {
  my $pp = $_[0];
  my ($epsi, $warnings) = (0.0001, "");
  ## check for bad values
  my %names = ('n*s02'=>'n*S02', ss2=>'sigma^2', dr=>'delta_R', e0=>'e0', ei=>'ei',
	       dphase=>'dphase', '3rd'=>'3rd cumulant', '4th'=>'4th cumulant');
  foreach my $k (qw(n*s02 ss2 dr e0 ei dphase 3rd 4th)) {
    next unless exists $$pp{$k};
    if ($$pp{$k} eq 'tilt') {
      $warnings .= "The $names{$k} of \"$$pp{descriptor}\" (path $$pp{index}) is not a number.\n\n";
      $$pp{$k} = $epsi;
    };
  };
 SWITCH: {
    my $s02 = ($paths{data0}->vstr == 1.02005) ? 'n*s02' : 's02';
    ($config{warnings}{s02_neg} and
     ($$pp{$s02} < 0)) and do {
       $warnings .= "The S02 of \"$$pp{descriptor}\" (path $$pp{index}) is negative.\n\n";
       last SWITCH;
     };
    ($config{warnings}{s02_max} and
     ($$pp{$s02} > $config{warnings}{s02_max})) and do {
       $warnings .= "The S02 of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
       last SWITCH;
     };

    ($config{warnings}{ss2_neg} and
     ($$pp{ss2} < 0)) and do {
      $warnings .= "The sigma^2 of \"$$pp{descriptor}\" (path $$pp{index}) is negative.\n\n";
      last SWITCH;
    };
    ($config{warnings}{ss2_max} and
     ($$pp{ss2} > $config{warnings}{ss2_max})) and do {
      $warnings .= "The sigma^2 of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
    ($config{warnings}{dr_max} and
     (abs($$pp{dr}) > $config{warnings}{dr_max})) and do {
      $warnings .= "The delta_R of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
    ($config{warnings}{e0_max} and
     (abs($$pp{e0}) > $config{warnings}{e0_max})) and do {
      $warnings .= "The e0 of \"$$pp{descriptor}\" (path $$pp{index}) is greater than $config{warnings}{e0_max} eV.\n\n";
      last SWITCH;
    };
    ($config{warnings}{ei_max} and
     (abs($$pp{ei}) > $config{warnings}{ei_max})) and do {
      $warnings .= "The ei of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
    ($config{warnings}{dphase_max} and
     (abs($$pp{dphase}) > $config{warnings}{dphase_max})) and do {
      $warnings .= "The dphase of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
    ($config{warnings}{'3rd_max'} and
     (abs($$pp{'3rd'}) > $config{warnings}{'3rd_max'})) and do {
      $warnings .= "The 3rd cumulant of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
    ($config{warnings}{'4th_max'} and
     (abs($$pp{'4th'}) > $config{warnings}{'4th_max'})) and do {
      $warnings .= "The 4th cumulant of \"$$pp{descriptor}\" (path $$pp{index}) is suspiciously large.\n\n";
      last SWITCH;
    };
  };
  return $warnings;
};


sub store_ppvalues {
  my ($this, $rpp) = @_;
  my %names = ('n*s02'=>'s02', ss2=>'sigma^2', dr=>'delr', e0=>'e0', ei=>'ei',
	       dphase=>'dphase', '3rd'=>'3rd', '4th'=>'4th');
  foreach my $key (keys %$rpp) {
    next unless exists($names{$key});
    my $p = $names{$key};
    #print join("|", $key, $$rpp{$key}), $/;
    $paths{$this} -> make("value_$p" => $$rpp{$key});
  };
};


sub show_correlations {
  my $fh = $_[0];
  my @order;
  foreach (@gds) {
    push @order, $_->name if ($_->type eq 'guess');
  };
  my $nd = 0;
  my %bkg_map;
  foreach my $d (keys %paths) {	# get all bkg params from all data sets
    next unless (ref($paths{$d}) =~ /Ifeffit/);
    next unless ($paths{$d}->type eq 'data');
    $nd = $paths{$d}->get('data_index');
    if ($paths{$d}->get('do_bkg') eq 'yes') {
      my $i = 1;
      my $bkg = sprintf("bkg%2.2d_%2.2d", $nd, $i);
      while (Ifeffit::get_scalar($bkg)) {
	push @order, $bkg;
	++$i;
	$bkg = sprintf("bkg%2.2d_%2.2d", $nd, $i);
      };
    };
    my $this = sprintf("bkg%2.2d_XX", $nd);
    $bkg_map{$this} = $paths{$d}->descriptor();
  };
  my @correls;
  my $cormin = $paths{&first_data}->{cormin};
  $paths{data0} -> dispose("\n## get correlations\n", $dmode);
  $paths{data0} -> dispose('correl(x=@all, y=@all, save, min=0)', $dmode);

  foreach my $i (0 .. $#order) {
    INNER: foreach my $j ($i .. $#order) {
	next INNER if ($i == $j);
	## default is to skip correlations between background parameters
	## belonging to the same data set
	next INNER if ((lc($config{data}{bkg_corr}) eq 'no') and
		       ($order[$i] =~ /bkg(\d\d)_\d\d/) and
		       ($order[$j] =~ /bkg$1_\d\d/));
	my $cor = join("_", "correl", $order[$j], $order[$i]);
	my $val = Ifeffit::get_scalar($cor);
	next INNER unless (abs($val) > $cormin);
	push @correls, [$order[$i], $order[$j], $val];
      };
    };
  $paths{data0} -> dispose("\n", $dmode);
  @correls = sort { abs(@$b[2]) <=> abs(@$a[2]) } @correls;
  print $fh "\n\nCorrelations between variables:\n";
  foreach (@correls) {
    my $str = sprintf("  %10s and %-10s --> %7.4f\n", @$_);
    print $fh $str;
  };
  print $fh "All other correlations are below $cormin\n\n";
  my $did_bkg = grep {$paths{$_}->get('do_bkg') eq 'yes'} (&all_data);
  return unless $did_bkg;
  foreach my $k (sort (keys %bkg_map)) {
    print $fh sprintf("Background parameters \"%s\" belong to data set %s\n",
		      $k, $bkg_map{$k});
  };
};

##  END OF THE PALETTES SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##
## THE FITTING SUBSECTION



sub generate_script {
  my $first = &first_data;
  my $how = $_[0];		# 0=write to file buffer
				# 1=dispose fit + plot
				# 2=dispose ff2chi + plot
  my $how_many = $_[1] || 'all';
  Echo("You have not opened a data file yet."), return unless (($how == 2) or $paths{$first}->get('file'));
 ECHO: {
    Echo("Writing script ..."), last ECHO if ($how == 0);
    Echo("Writing script and fitting ..."), last ECHO if ($how == 1);
    Echo("Writing script and summing for data set \"" . $paths{$paths{$current}->data}->descriptor . " ..."), last ECHO if ($how == 2);
  };

  ## this cannot proceed unless merge parameters have been resolved
  my ($nmerge, $first_merge) = &count_merge;
  if ($nmerge) {
    display_page("gsd");
    gds2_display($first_merge);
    # message to echo area
    Error("You must resolve all merged parameters before " .
	  ("writing a script.", "running a fit.", "making a summation.")[$how] );
    return;
  };

  ## empty out the space where the list of ill posed variables will go
  @Ifeffit::Tools::buffer = ();

  ## deal with the situation of hitting the big green button while
  ## editing a parameter
  gds2_update_mathexp($widgets{gds2list}, \%gds_selected) if ($current_canvas eq 'gsd');

  ## --- Save autosave file
  &save_project(0,1);

  my ($wbg, $wfn, $wbt) = ($config{colors}{warning_bg},
			   $config{fonts}{smbold},
			   $config{colors}{warning_fg});
  my ($bg, $fn, $bt) = ($config{colors}{background},
			$config{fonts}{small},
			$config{colors}{button});

  ## --- need a list of the selected paths for writing the log file in
  ##     the case of a summation of selected paths
  my %selection;
  if ($how == 2) {
    map {$selection{$_} = 1} ($list->selectionGet);
  };

  my $warnings = "";
  ## make sure that the data and feffNNNN files actually exist as indicated
  my @ok = ();
  my $missing_feff = 0;
  my $missing = "Error finding data and/or FEFF files:\n\nArtemis could not find the following files:\n";

  ## --- check to see that all the files needed for the fit can be found
  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    next if ($p =~ /^\s*$/);
    next if ($p eq 'journal');
    next if (($paths{$p}->type eq 'gsd') or ($paths{$p}->type eq 'feff') or
	     ($paths{$p}->type eq 'fit') or ($paths{$p}->type eq 'bkg')  or
	     ($paths{$p}->type eq 'res'));
    next if (($paths{$p}->type eq 'data') and (not $paths{$p}->get('file')));
    my $file;
    my $data = $paths{$p}->data;
    ## --- data file, if included in the fit
    if ($paths{$p}->type eq 'data') {
      next unless $paths{$p}->included;
      $file = $paths{$p}->get('file');
      unless (-e $file) {
	push @ok, $paths{$p}->get('lab');
	$missing .= "  Data:\t$file\n";
      };
    };
    ## --- paths, if included in the fit
    if ($paths{$p}->type eq 'path') {
      next unless $paths{$data}->included;
      next unless $paths{$p}->included;
      $file = File::Spec->catfile($paths{$p}->get('path'),
				  $paths{$p}->get('feff'));
      unless (-e $file) {
	++$missing_feff;
	$missing .= "  Path \`" . $paths{$p}->descriptor() . "\':\t$file\n";
      };
    };
  };
  $missing_feff && push @ok, "one or more feffNNN.dat files";
  my $message = join(" and ", @ok);
  ## --- post a message identifying the missing files, then bail
  if ($message) {
    Error("Artemis could not find $message.");
    post_message($missing, 'Error messages');
    return 0
  };


  ## --- check that every data set has at least one path associated
  ##     with it, post message explaining problem if problem found
  my $datafeff = "";
  foreach my $d (&all_data) {
    ($datafeff .= "The data set \"" . $paths{$d}->descriptor() . "\" has no included feff paths\n\tassociated with it.\n\n")
      unless data_paths($d);
  };
  if ($datafeff) {
    $datafeff .= "\nArtemis cannot continue.\n\tYou must either add some paths to the indicated data\n\tset(s) or exclude those data set(s) from the fit.\n";
    Error("There are severe errors in the fitting model!");
    post_message($datafeff, 'Error messages');
    return 0;
  };

  ## --- trying to do an ff2chi on a data file not included in the fit
  my $ff2chi_data;
  ($ff2chi_data = $paths{$current}->data) if ($how == 2);
  Error("You cannot do ff2chi on " . $paths{$ff2chi_data}->get('lab') . " because it is excluded from fitting."),
    return if (($how==2) and (not $paths{$ff2chi_data}->included));

  my $is_busy = grep (/Busy/, $top->bindtags);
  $is_busy or $top -> Busy();


  ## --- make sure that there are included paths in the fit
  my @paths = grep {exists($paths{$_}->{type}) and
		      ($paths{$_}->type eq 'path')} &path_list;
  my $selected_paths = 0;
  foreach (@paths) {
    $selected_paths ||= $paths{$_}->included;
  };
  unless ($selected_paths) {
    Echo ("You have not included any paths for fitting.");
    $top->Unbusy;
    return;
  };

  ## --- just about ready to start fitting
  my $string .= "\n" . "#" x 40 .
    "\n# Starting a new fit\n" .
      "\n# Guess, def, and set parameters:\n";
  $string .= "unguess\n";
  ##&read_gds2(0);			# update gsd object

  ## --- do some error checking on the parameters...
  my $is_err = 0;
  my $error  = ($how==1) ? &check_idp : "";
  my ($this_err, $must_stop) = ("", 0);
  ++$is_err if $error;
				## data parameters
  ($error) and ($error .= "\n\n");
  $this_err  = &verify_data_parameters;
  $error    .= $this_err;
  #($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## number of paths
  ($error) and ($error .= "\n\n");
  $this_err  = &verify_number_of_paths;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## number of variables
  ($error) and ($error .= "\n\n");
  $this_err  = &verify_number_of_variables;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## rmin < Rbkg
  ($error) and ($error .= "\n\n");
  $this_err  = &verify_rmin_rbkg;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## binary operators
  ($error =~ /^\s$/m) or ($error .= "\n\n");
  $this_err  = &verify_operators;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## matching parens
  ($error =~ /^\s$/m) or ($error .= "\n\n");
  $this_err  = &verify_parens;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## parameters named like program variables
  ($error =~ /^\s$/m) or ($error .= "\n\n");
  $this_err  = &verify_ifeffit_program_variables;
  $error    .= $this_err;
  ($must_stop = 1) if $this_err;
  ++$is_err if $this_err;
				## parameters defined and used
  ($error =~ /^\s$/m) or ($error .= "\n\n");
  my $unused_defs = 0;
  ($this_err, $unused_defs) = &verify_parameters;
  $error    .= $this_err;
  ++$is_err if $this_err;

  if ($how != 2) {
				## R-range compared to Reff values
    ($error =~ /^\s$/m) or ($error .= "\n\n");
    $this_err  = &verify_reffs;
    $error    .= $this_err;
    ++$is_err if $this_err;
  };

  ## --- clear out the Messages tab
  $notes{messages} -> delete(qw(1.0 end));
  ##$current_file = "";
  $top -> update;

  ## --- post a message if trouble was found among the parameters
  if ($must_stop) {
    post_message($error, "Error Messages");
    Error("Fit aborted due to unrecoverable errors in your project.  See Messages buffer (control-4)");
    $top->Unbusy;
    $update->raise;
    return;
  } elsif ($is_err) {
    post_message($error, "Error Messages");
    my $dialog =
      $top -> Dialog(-bitmap         => 'warning',
		     -text           => "There are errors in your math expressions.  Do you want to abort this fit or carry on regardless?",
		     -title          => 'Artemis: Errors...',
		     -buttons        => [qw/Continue Abort/],
		     -default_button => 'Abort',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    $top->update;
    ## offer to convert any unused def parameters into either skip or
    ## after parameters, then issue the right message for aborted or
    ## continued fits
    if (@$unused_defs) {
      my $string = '("'.join('", "', @$unused_defs).'")';
      my $dia =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => "Would you like to change the unused def parameters $string into skip or after parameters?",
		       -title          => 'Artemis: Def parameters...',
		       -buttons        => ["Change to skip", "Change to after", "Do nothing"],
		       -default_button => 'Change to skip',
		       -font           => $config{fonts}{med},
		       -popover        => 'cursor'
		      );
      &posted_Dialog;
      my $resp = $dia->Show();
      unless ($resp eq "Do nothing") {
	my $changeto = (split(" ", $resp))[2];
	gds2_def_to_other($changeto, $unused_defs);
	if ($response eq 'Abort') {
	  Error("Fit aborted and all unused def parameters were converted to $changeto parameters.");
	  $top->Unbusy;
	  return;
	} else {
	  Echo("All unused def parameters were converted to $changeto parameters.");
	};
      };
    };
    if ($response eq 'Abort') {
      Error("Fit aborted due to errors in parameters and math expressions.");
      $top->Unbusy;
      $update->raise;
      return;
    };
  } else {
    post_message if ($notes{messages} -> get(qw(1.0 end)) =~ /^\s*Errors/);
    $update->raise;
  };


  ## --- make this fit folder, get fit meta data
  my $project_fit_dir;
  ##my ($fit_label, $fit_comment, $fit_fom) = ("", "", 0);
  if ($how) {
    Echo("Making fit folder ...");
    my %save = (label => $fit{label}, comment    => $fit{comment},
		count => $fit{count}, count_full => $fit{count_full},
		fom   => $fit{fom});
    my $prev_label = "";
    if (-e File::Spec->catfile($project_folder, "fits",
			       sprintf("fit%4.4d", $fit{count}), 'label')) {
      open PL, File::Spec->catfile($project_folder, "fits",
				   sprintf("fit%4.4d", $fit{count}), 'label');
      $prev_label = <PL>;
      close PL;
    };
    ($prev_label =~ s/\bsum\b/fit/) if ($how == 1);
    ($prev_label =~ s/\bfit\b/sum/) if ($how == 2);

    ## get the most recent fit number, then set $fit{count} according
    ## to the value of $fit{new}
    opendir F, File::Spec->catfile($project_folder, "fits");
    my @fits = sort( grep {/fit\d+/ and -d  File::Spec->catfile($project_folder, "fits", $_)} readdir(F) );
    closedir F;
    my $prev = (@fits) ? sprintf("%d", substr($fits[$#fits],3)) : 0;
    $fit{count} = ($fit{new}) ? $prev+1 : $prev;
    ++$fit{count_full};
    $fit{label}     = $prev_label;
    $fit{label}   ||= ($how == 1) ? "fit $fit{count}"  : "sum $fit{count}";
    $fit{label}    =~ s/\b$prev\b/$fit{count}/g;
    $fit{comment}   = $props{Comment};
    ($fit{comment} =~ s/\bSummation\b/Fit/) if ($how == 1);
    ($fit{comment} =~ s/\bFit\b/Sum/) if ($how == 2);
    $fit{comment} ||= ($how == 1) ? "Fit #$fit{count}" : "Summation #$fit{count}";
    #$fit{comment}  =~ s/\b$prev\b/$fit{count}/g;
    $fit{fom} = $fit{count};
    $project_fit_dir = File::Spec->catfile($project_folder, "fits",
					   sprintf("fit%4.4d", $fit{count}));
    if ($config{general}{fit_query}) {
      Echo("Getting fit information ...");
      my $chore = ($how == 1) ? "Run fit" : "Make sum";
      my $title = ($how == 1) ? "fit" : "summation";
      my $db = $top -> DialogBox(-title=>"Artemis: Information about this $title",
				 -buttons=>[$chore, 'Cancel'],
				 -default_button=>$chore);
      my $fr = $db->Frame(-borderwidth=>2, -relief=>'flat')->pack(-pady=>5);
      $title = ($how == 1) ? "run a fit" : "make a summation";
      $fr -> Label(-text=>"You are about to $title.  Artemis needs some",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
	-> pack(-side=>'top');
      $fr -> Label(-text=>"information to help you organize your project.",
		   -font=>$config{fonts}{large},
		   -foreground=>$config{colors}{activehighlightcolor})
	-> pack(-side=>'top');

      my @button = (-foreground=>$config{colors}{activehighlightcolor},
		    -font=>$config{fonts}{med},
		    -activeforeground=>$config{colors}{mbutton},
		    -relief=>'flat', -borderwidth=>0,);
      $fr = $db->Frame(-borderwidth=>2, -relief=>'groove')->pack;
      $fr -> Button(-text=>"Label: ", @button,
		    -command=>[\&Echo, 'The label that will be used in the Paths list'])
	-> grid(-column=>0, -row=>0, -sticky=>'w', -pady=>2);
      $fr -> Entry(-width=>20, -textvariable=>\$fit{label})
	-> grid(-column=>1, -row=>0, -sticky=>'w', -pady=>2);
      $fr -> Button(-text=>"Comment: ", @button,
		    -command=>[\&Echo, 'A brief description of this fit.  This will the Comment on the Project Properties page.'])
	-> grid(-column=>0, -row=>1, -sticky=>'w', -pady=>2);
      $fr -> Entry(-width=>60, -textvariable=>\$fit{comment})
	-> grid(-column=>1, -row=>1, -sticky=>'w', -pady=>2);
      $fr -> Button(-text=>"Figure of merit: ", @button,
		    -command=>[\&Echo, 'A number associated with this fit (for instance, the temperature in a temperature series)'])
	-> grid(-column=>0, -row=>2, -sticky=>'w', -pady=>2);
      $fr -> Entry(-width=>6, -textvariable=>\$fit{fom})
	-> grid(-column=>1, -row=>2, -sticky=>'w', -pady=>2);
      my $rfr = $fr -> Frame
	-> grid(-column=>0, -row=>3, -columnspan=>2, -sticky=>'w', -padx=>8, -pady=>2);
      $rfr -> Radiobutton(-text=>"Make a new fit entry",
			  -variable=>\$fit{new},
			  -value=>1,
			  -selectcolor=>$config{colors}{check},
			  -foreground=>$config{colors}{activehighlightcolor},
			  -activeforeground=>$config{colors}{activehighlightcolor},
			  -state=>($fit{count_full}>1) ? 'normal' : 'disabled',
			  -command=>sub{&fit_toggle_new(\$project_fit_dir, $how)})
	-> pack(-side=>'left');
      $rfr -> Radiobutton(-text=>"Reuse previous fit entry",
			  -variable=>\$fit{new},
			  -value=>0,
			  -selectcolor=>$config{colors}{check},
			  -foreground=>$config{colors}{activehighlightcolor},
			  -activeforeground=>$config{colors}{activehighlightcolor},
			  -state=>($fit{count_full}>1) ? 'normal' : 'disabled',
			  -command=>sub{&fit_toggle_new(\$project_fit_dir, $how)})
	-> pack(-side=>'left');
      $fr -> Button(-text=>"Document: fit information dialog", @button2_list,
		    -command=>sub{pod_display("artemis_fitinfo.pod")})
	-> grid(-column=>0, -row=>4, -columnspan=>2, -sticky=>'ew', -pady=>2, -padx=>2);
      my $answer = $db -> Show;
      if ($answer eq 'Cancel') {
	## restore the fit hash upon canceling
	foreach my $k (qw(label comment count count_full fom)) {
	  $fit{$k} = $save{$k};
	};
	Echo("Fit aborted!");
	$top -> Unbusy;
	return;
      };
    };
    $fit{label} =~ s/\'/\"/g;	# care with quotes
    $fit{label} =~ s/\s+$//;	# trim railing spaces
    $props{Comment} = $fit{comment};
    mkpath $project_fit_dir unless (-d $project_fit_dir);
  };


  ## --- and carry on if there are no obvious problems
  set_status(0);
  Echo("Generating ifeffit commands ...");

  ## --- define all the GDS parameters
  my @sets = ();
  foreach (@gds) {
    push @sets, $_ if ($_->type eq 'set');
  };
  if ($config{general}{sort_set}) {
    foreach (sort byuse @sets) { $string .= $_ -> write_gsd(0) };
  } else {
    foreach (@sets) { $string .= $_ -> write_gsd(0) };
  };
  $string .= $/;
  if ($how == 2) {
    ## use bestfit values for the summation
    foreach (@gds) { $string .= $_ -> write_gsd(1) if ($_->type eq 'guess');    };
  } else {
    ## otherwise use the mathexp values
    foreach (@gds) { $string .= $_ -> write_gsd(0) if ($_->type eq 'guess');    };
  };
  $string .= $/;
  foreach (@gds) { $string .= $_ -> write_gsd(0) if ($_->type eq 'def');      };
  $string .= $/;
  foreach (@gds) { $string .= $_ -> write_gsd(0) if ($_->type eq 'restrain'); };

  ## --- now read in all the data
  $string .= "\n\n# Read data:\n";
  foreach my $d (&all_data) {
    next if (($how==2) and ($ff2chi_data ne $d));
    last if (($how==2) and (not -e $paths{$d}->get('file')));
    my $this =  $paths{$d}->get('lab');
    $paths{$d} -> make(included=>[], inc_mapping=>[]);
    ## read_data
    if ($paths{$d}->{is_rec}) {
      $string .= "# The data was for $this was imported from an Athena record file:\n";
      $string .= "#   " . $paths{$d}->get('file') . "\n";
    } else {
      $string .= "## read data for $this:\n";
      $string .= "read_data(file=\"" . $paths{$d}->get('file') . "\",\n";
      $string .= "          type=chi, group=" . $paths{$d}->get('group') . ")\n";
    };
  };

  ## --- write all the paths
  $string .= "\n\n# Paths:\n";
  my $i = 0;
  my @included;
  my @inc_mapping = ();
  foreach my $p (@paths) {
    next unless (($how_many eq 'all selected') or ($paths{$p}->included));  # skip paths deselected for fit
    next if (($how_many eq 'all selected') and (not $list->selectionIncludes($p)));
    ++$i;
    my $ind    = $paths{$p} -> index;
    ##my $parent = $paths{$p}->get('parent');
    my $data   = $paths{$p}->data;
    my $pathto = $paths{$p}->get('path');
    push @{$paths{$data}->{included}}, $ind;
    $paths{$data}->{inc_mapping}->[$ind] = $p;
    $string   .= $paths{$p} -> write_path($ind, $pathto, $config{paths}{extpp}, $stash_dir);
  };

  ## --- get the list of restraints
  my $restraints = "";
  foreach my $p (@gds) {
    next unless ($p->{type} eq "restrain");
    $restraints .= "restraint=" . $p->name . ", ";
  }

  ## --- generate a feffit() of ff2chi() command for each data set
  my $npaths = $i;
  my $nsets = $paths{data0} -> count_data_sets();
  my $iset = 1;
  ($string .= "\n\n# Do the fit!\n") if ($how==1);
  foreach my $d (&all_data) {
    my $this =  $paths{$d}->get('lab');
    if ($how == 2) { ## --- only do ff2chi for the current data
      next unless ($ff2chi_data eq $d);
      $string .= "\n\n# Run ff2chi!\n";
      ## --- an ff2chi can be on all paths or on the selected paths
      if ($how_many =~ /sel/) { # selected and included
	my @sel = ();
	foreach my $p ($list->selectionGet) {
	  next unless (ref($paths{$p}) =~ /Ifeffit/);
	  next unless ($paths{$p}->type eq 'path');
	  next unless ($paths{$p}->data eq $d);
	  next unless ($paths{$p}->included);
	  push @sel, $paths{$p}->get('fit_index');
	};
	unless (@sel) {
	  Echo("There are no selected paths for data set \"$this\".");
	  --$fit{count};
	  $top -> Unbusy;
	  return;
	};
	$string .= $paths{$d} -> write_ff2chi( &normalize_paths(\@sel) );
      } else {

	my @sel = ();
	foreach my $p (keys(%paths)) {
	  next unless (ref($paths{$p}) =~ /Ifeffit/);
	  next unless ($paths{$p}->type eq 'path');
	  next unless ($paths{$p}->data eq $d);
	  next unless ($paths{$p}->included);
	  push @sel, $paths{$p}->get('fit_index');
	};
	unless (@sel) {
	  Echo("There are no included paths for data set \"$this\".");
	  --$fit{count};
	  $top -> Unbusy;
	  return;
	};
	$string .= $paths{$d} ->
	  write_ff2chi( &normalize_paths(\@sel) );
      };
      $string .= "\n\n# Plot data and simulation in fitting space\n";
    } else {
      $string .= "\n## fitting $this ...\n" ;
      $string .= "## === data set \#$iset of $nsets\n";
      ## --- need to keep track of which data set this in in this fit
      ##     so that background parameters can be found later on
      $paths{$d} -> make(data_index=>$iset);
      my $res_list = ($iset == $nsets) ? $restraints : "";
      $string .= $paths{$d} ->
	write_feffit( &normalize_paths($paths{$d}->{included}), $iset, $nsets, $res_list);
      ++$iset;
      $string .= "\n";
    }
  }

  ## --- establish ifeffit's current path for def parameter evaluation
  my $which = &which_set_path;
  if ($which) {
    $string .= "## set default path for def parameter evaluation\n";
    $string .= "set path_index = " . $paths{$which}->get('fit_index');
  };

  ## --- prep the bkg data
  if ($how!=2) {
    foreach my $d (&all_data) {
      my $this =  $paths{$d}->get('lab');
      my $g    = $paths{$d}->get('group');
      $string .= "\n\n## Background data for $this ...\n";
      if ($paths{$d}->get('do_bkg') eq 'yes') {
	$string .= "set(" . $g . "_bkg.k   = $g.k)\n";
	$string .= "set(" . $g . "_bkg.chi = " . $g . "_fit.kbkg)\n";
	##$string .= "## the following line is a crude hack to sidestep a bug Bruce cannot figure out\n";
	##$string .= "     set foo.x = " . $g . "_bkg.chi\n";
	##$paths{$g.".2"}->make(do_r=>1);
	$plot_features{bkg} = "b";
      } else {
	$plot_features{bkg} = 0;
      };
    };
  };

  ## --- make residual data (need to zero values outside fit range)
  foreach my $d (&all_data) {
    next if (($how==2) and ($ff2chi_data ne $d));
    last if (($how==2) and (not -e $paths{$d}->get('file')));
    my $this =  $paths{$d}->get('lab');
    my $g    = $paths{$d}->get('group');
    $string .= "\n## Residual data for $this ...\n";
    $string .= sprintf("set(%s_res.k = %s.k)\n", $g, $g);
    $string .= sprintf("set(%s_res.chi = %s.chi - %s_fit.chi)\n", $g, $g, $g);
  };

  ## --- make sure do_k flag is set throughout the project
  foreach (keys %paths) {
    next unless (ref($paths{$_}) =~ /Ifeffit/);
    next unless ($paths{$_}->type);
    next if (/$no_plot_regex$/o);
    next if (/^\s*$/);
    $paths{$_}->make(do_k=>1);
  };

  ### somewhere in the following block data0.0 etc get unhidden see
  ###   earlier versions for examples of list entries being made on
  ###   the fly

  ## --- show Fit, Background, and Residual list entries
  foreach my $d (&all_data) {
    next if (($how==2) and ($ff2chi_data ne $d));
    if ($how) {
      $paths{$d.'.0'} ||=  Ifeffit::Path -> new(id=>$d.".0", type=>'fit', group=>$d.'_fit',
						sameas=>$d, lab=>'Fit',
						parent=>0, family=>\%paths);
      $list -> show('entry', $paths{$d}->get('id').".0");
      $paths{$d}->make(with_fit=>1);
    };
  };
    ##     if ($how == 1) {
    ##       $list -> show('entry', $paths{$d}->get('id').".1");
    ##       $paths{$d}->make(with_res=>1);
    ##     };
    ##     if (($how == 1) and ($paths{$d}->get('do_bkg') eq 'yes')) {
    ##       $list -> show('entry', $paths{$d}->get('id').".2");
    ##       $paths{$d}->make(with_bkg=>1);
    ##     };
  ##};


  ## --- select and anchor the plotted data set
  my $to_plot;
  foreach (&all_data) {
    ($to_plot = $_), last if $paths{$_}->get('plot');
  };
  unless ($to_plot) {
    $to_plot = &first_data;
    $paths{$to_plot}->make(plot=>1);
  };
  ($to_plot = $ff2chi_data) if ($how == 2);
  if ($how) {
    $list -> see($list->info('prev', $paths{$to_plot}->get('id')));
    $list -> anchorSet($to_plot);
  };
##   foreach (&all_data) {
##     $paths{$_}->make(plot=>0);
##   };
##   $paths{$to_plot}->make(plot=>1);
  ## what does this next block do??  is it a remnant of the ancient
  ## difference spectrum scheme??
##   unless (($how==2) and (not -e $paths{$to_plot}->get('file'))) {
##     $list -> selectionClear;
##     $list -> anchorSet($to_plot.'.0') if ($how_many =~ /sel/);
##     if ($paths{$to_plot}->{fit_diff}) {
##       $list -> selectionSet($to_plot.'.3');
##       $list -> anchorSet($to_plot.'.3');
##     } else {
##       $list -> selectionSet($to_plot);
##       $list -> anchorSet($to_plot);
##     };
##     $list -> see($paths{$to_plot}->get('id').'.0') if $how;
##     display_properties if $how;
##   };


  ## -- plot the data and fit of the chosen (or first) data set
  my $plot_string = "\n\n# Plot data and fit in fitting space\n";
  $list -> selectionClear;
  if ($how==1) {		# fitting
    $list -> selectionSet($paths{$to_plot}->get('id').'.0');
    foreach my $d (&all_data) {
      $list -> entryconfigure($paths{$d}->get('id').".0",
			      -text=>"Fit");
                              ##-text=>"Fit [$fit{count_full}]");
      $paths{$d}->make(count_full=>$fit{count_full});
      if ($paths{$d}->get('plot')) {
	$list -> selectionSet($paths{$d}->get('id'));
	$list -> selectionSet($paths{$d}->get('id').".0");
      };
    };
  } elsif ($how==2) {		# ff2chi-ing
    $list -> selectionSet($paths{$ff2chi_data}->get('id').'.0');
    $list -> entryconfigure($paths{$ff2chi_data}->get('id').".0",
			    -text=>"Sum");
			    ##-text=>"Sum [$fit{count_full}]");
    foreach my $d (&all_data) {
      $paths{$d}->make(count_full=>$fit{count_full});
    };
  };
  unless ($how == 0) {
    foreach my $p (keys %paths) {
      next unless (exists($paths{$p}) and $paths{$p});
      next unless ($paths{$p}->type eq 'path');
      $list -> selectionSet($paths{$p}->get('id')) if $paths{$p}->get('plotpath');
    };
  };

  unless (($how==2) and (not -e $paths{$to_plot}->get('file'))) {
    $plot_string .= "read_data(file=\"" . $paths{$to_plot}->get('file') . "\",\n" .
                    "          type=chi, group=". $paths{$to_plot}->get('group') . ")\n";
  };

  $plot_string .= plot($paths{$to_plot}->get('fit_space'), 1, 1);
  ($how) or ($plot_string .= "echo \"...and you need to FT and plot the fit as well...\"\n");

  ## --- ready to dispose this fitting script
  Echo("Generating ifefit commands ... done!");
  if ($how == 0) {
    post_message($string.$plot_string, 'Ifeffit script');
    $update->raise;
  } else {
    Running(($how == 2) ?
	 "Making the sum of paths (this could take a few minutes, please be patient) ..." :
	 "Running fit (this could take a few minutes, please be patient) ...");
    @bad_params = ();
    $paths{data0} -> dispose($string, $dmode);
    $parameters_changed = 0 if $how; # flag parameters as not changed

    $props{'Last fit'} = $paths{data0} -> date_of_file;

    foreach (keys %paths) {	# flag all for updating
      next unless (ref($paths{$_}) =~ /Ifeffit/);
      next unless $paths{$_}->type;
      next if (/$no_plot_regex$/);
      $paths{$_}->make(do_k=>1);
    };

    ## --- set state of various File menu options based on how the fit was done
    ##$file_menu->menu->entryconfigure($save_index+1, -state=>'normal'); # fit
##     if ($paths{$paths{$current}->data}->get('with_bkg')) {
##       $data_menu->menu->entryconfigure(2, -state=>'normal');# bkgsub
##       #$file_menu->menu->entryconfigure($save_index+2, -state=>'normal');# bkg
##     };
##     if (-e $paths{$paths{$current}->data}->get('file')) { # don't enable in case of data-less ff2chi
##       ##$file_menu->menu->entryconfigure($save_index+3, -state=>'normal'); # resid
##       $fit_menu->menu->entryconfigure(4, -state=>'normal'); # running R-factor
##     };
  };

  ### --- put best fit & error values in the parameter objects
  if ($how) {
    $paths{data0} -> dispose( "\n## Evaluate after-fit parameters ...\n", $dmode);
    foreach my $p (@gds) {
      if ($p->{type} eq 'guess') {
	$p->make(bestfit  => sprintf("%.6f", Ifeffit::get_scalar($p->name)),
		 error    => 0);
	if ($how == 1) {
	  $p->make(error    => sprintf("%.6f", Ifeffit::get_scalar("delta_".$p->name)));
	  $p->make(note     => sprintf("%s = %s +/- %s", $p->name, $p->bestfit, $p->error))
	    if $p->autonote;
	};
      } elsif ($p->{type} eq 'def') {
	$p->make(bestfit  => sprintf("%.6f", Ifeffit::get_scalar($p->name)));
	if ($how == 1) {
	  $p->make(note   => sprintf("%s = %s", $p->name, $p->bestfit)) if $p->autonote;
	};
      } elsif ($p->{type} eq 'restrain') {
	$p->make(bestfit  => sprintf("%.6f", Ifeffit::get_scalar($p->name)));
	if ($how == 1) {
	  $p->make(note   => sprintf("%s = %s", $p->name, $p->bestfit)) if $p->autonote;
	};
      } elsif ($p->{type} eq 'after') {
	## evaluate the after, then store its value
	my $after_string = sprintf("%s = %s\n", $p->name, $p->mathexp);
	$paths{data0} -> dispose($after_string, $dmode);
	$p->make(bestfit  => sprintf("%.6f", Ifeffit::get_scalar($p->name)));
	if ($how == 1) {
	  $p->make(note   => sprintf("%s = %s", $p->name, $p->bestfit)) if $p->autonote;
	};
      };
    };
    $paths{data0} -> dispose( "\n\n", $dmode);
    repopulate_gds2();
  };

  ## --- post fitting chores
  if ($how) {

    Running("Writing log file ...");
    $widgets{results_save} -> configure(-state=>'normal');
    $notes{results} -> configure(-state=>'normal');
    $notes{results} -> delete(qw(1.0 end));
    my $fh;
    ## --- save the log file to this fit folder
    open $fh, ">".File::Spec->catfile($project_fit_dir, "log");
    #my @a;
    #@a=localtime; print "$a[1]:$a[0] calling results_header\n";
    &write_results_header($fh, \%fit);
    #@a=localtime; print "$a[1]:$a[0] calling results\n";
    &write_results($fh, $how, $how_many);
    #@a=localtime; print "$a[1]:$a[0] calling show_correlations\n";
    &show_correlations($fh) if ($how == 1);
    foreach my $d (&all_data) {
      next if (($how == 2) and ($d ne $paths{$current}->data));
      my $lab = $paths{$d}->get('lab');
      print $fh join("", "\n\n\n", "=" x 5,
		     " Data set >>$lab<< ", "=" x 40, "\n\n");
      #@a=localtime; print "$a[1]:$a[0] calling write_opparams\n";
      &write_opparams($fh, $d);
      print $fh join("", "\n\n  ", "=" x 5,
		     " Paths used to fit $lab\n");
      #@a=localtime; print "$a[1]:$a[0] calling write_paths\n";
      if ($paths{data0} -> vstr >= 1.02005) {
	$warnings .= &write_paths($fh, $d, $how, $how_many, \%selection);
      } else {
	$warnings .= &write_paths_pre_1_2_5($fh, $d, $how, $how_many, \%selection);
      };
    };
    close $fh;
    #@a=localtime; print "$a[1]:$a[0] calling log_file_display\n";
    log_file_display();
    $widgets{results_choose} -> configure(-state=>'normal');
    $notes{results} -> yviewMoveto(0);
    raise_palette('results');
    $update->raise;

    ## --- save the fits to this fit folder
    Running("Saving fit information ...");
    my $ll = ($how ==1) ? "fit" : "sum";
    my $id = "";
    foreach my $d (&all_data) {
      ## remember whether the most recent was a fit or a sum, this is
      ## needed for labeling the DPL when deleting fits
      $fit{recent} = ($how == 1) ? 'fit' : 'sum';
      next if (($how == 2) and ($d ne $paths{$current}->data));
      my $fname = $d . ".fit";
      my $bname = $d . ".bkg";
      my $rname = $d . ".res";
      ##my $id = join(".", $d, '0', $fit{count});
      if ($fit{new}) {
	$id = $d.".0.".$fit{count};
	$list->add($id);
	$fit{label} ||= join(" ", $ll, $fit{count});
	$paths{$id} = Ifeffit::Path -> new(id       => $id,
					   type     => 'fit',
					   group    => $d.'_fit_'.$fit{count},
					   sameas   => $d,
					   lab      => $fit{label},
					   value    => $fit{fom},
					   folder   => sprintf("fit%4.4d", $fit{count}),
					   filename => $fname,
					   parent   => $d.".0",
					   family   => \%paths,
					  );
      } else {
	my $i = $fit{count}; #-1;
	$id = "$d.0.$i";
	$paths{$id} -> make(lab		 => $fit{label},
			    value	 => $fit{fom},
			    imported	 => 0,
			    imported_bkg => 0,
			    imported_res => 0,
			   );
      };
      ## store whether the most recent call to this subroutine was for
      ## a fit or a sum.  this is needed so that DPL label can be set
      ## correctly when importing a project file.
      my $fsfile = File::Spec->catfile($project_fit_dir, "$d.fs");
      open FS, ">".$fsfile;
      print FS $fit{recent};
      close FS;

      ## store FT and fit parameters in this fit object
      my $ftfile = File::Spec->catfile($project_fit_dir, "$d.FT");
      open FT, ">".$ftfile;
      foreach my $k (qw(kmin kmax dk kwindow rmin rmax dr rwindow)) {
	my $val = $paths{$d}->get($k);
	$paths{$id} -> make($k => $val);
	print FT $k, "=", $val, $/;
      };
      close FT;
      $paths{$d.".0"} -> make(plot=>$d.'_fit_'.$fit{count},
			      thisfit=>$id);
      $list -> entryconfigure($id, -style=>$list_styles{$paths{$id}->pathstate("enabled")},
			      -text=>$paths{$id}->get('lab'));
      my $group = $paths{$d.".0"}->get('group');
      $fname = File::Spec->catfile($project_fit_dir, $fname);
      ## store the fit, bkg, and res filenames for quick reference
      ## when plottings
      $paths{$id} -> make(fitfile=>$fname);
      $paths{$id} -> make(bkgfile=>File::Spec->catfile($project_fit_dir, $bname))
	if ($paths{$d}->get('do_bkg') eq 'yes');;
      $paths{$id} -> make(resfile=>File::Spec->catfile($project_fit_dir, $rname));
      $paths{$d} -> dispose("write_data(file=$fname,\n           label=\"k chi\", $group.k, $group.chi)");
      ## --- save the bkg and residual data to the fit folder
      if ($paths{$d}->get('do_bkg') eq 'yes') {
	$fname = File::Spec->catfile($project_fit_dir, $d.".bkg");
	$paths{$d} -> dispose("write_data(file=$fname,\n           label=\"k chi\", ${d}_bkg.k, ${d}_bkg.chi)");
      };
      $fname = File::Spec->catfile($project_fit_dir, $d.".res");
      $paths{$d} -> dispose("write_data(file=$fname,\n           label=\"k chi\", ${d}_res.k, ${d}_res.chi)");
      ## --- save the header to the fit folder
      foreach my $d (&all_data) {
	next if (($how == 2) and ($d ne $paths{$current}->data));
	my $header = "";
	foreach ('Project title', 'Comment', 'Prepared by', 'Contact', 'Started', 'Last fit', 'Environment') {
	  my $this = $_;
	  ($this = "This fit at") if ($this eq 'Last fit');
	  $header .= sprintf("# %-15s :  ", $this);
	  $header .= "\n", next if (not defined($props{$_}));
	  $header .= "\n", next if ($props{$_} =~ /^\<.*\>$/);
	  $header .= "\n", next if ($props{$_} =~ /^\s*$/);
	  $header .= "$props{$_}\n";
	};
	$header .= sprintf("# %-15s :  %s\n", "Figure of merit", $fit{fom});
	foreach my $l (split(/\n/, $paths{$d}->param_summary($plot_features{kweight}))) {
	  $header .= "# ".$l.$/;
	};
	open H, ">".File::Spec->catfile($project_fit_dir, "header.$d");
	print H $header;
	close H;
      };
    };

    ## --- save the description to this fit folder
    &save_description;
    my $description = File::Spec->catfile($project_folder, 'descriptions', 'artemis');
    copy($description, File::Spec->catfile($project_fit_dir, "description"));
    ##@-fp-@ save_fingerprint(File::Spec->catfile($project_fit_dir, "description"));

    ## --- touch the label file
    open L, ">".File::Spec->catfile($project_fit_dir, "label");
    print L $fit{label};
    close L;

    ## --- plot the fit
    Running("Plotting fit results ...");
    $list -> selectionClear;
    if ($how==1) {		# fitting
      foreach my $d (&all_data) {
	next unless ($paths{$d}->get('plot'));
	$list -> selectionSet($paths{$d}->get('id'));
	$list -> selectionSet($paths{$d}->get('id').".0");
      };
      #$list -> selectionSet($paths{$to_plot}->get('id'));
      #$list -> selectionSet($paths{$to_plot}->get('id').'.0');
    } elsif ($how==2) {		# ff2chi-ing
      $list -> selectionSet($paths{$ff2chi_data}->get('id'));
      $list -> selectionSet($paths{$ff2chi_data}->get('id').'.0');
    };
    unless ($how == 0) {
      foreach my $p (keys %paths) {
	next unless ($paths{$p}->type eq 'path');
	$list -> selectionSet($paths{$p}->get('id')) if $paths{$p}->get('plotpath');
      };
    };
    $plot_string = "\n\n# Plot data and fit in fitting space\n";
    unless (($how==2) and (not -e $paths{$to_plot}->get('file'))) {
      $plot_string .= "read_data(file=\"" . $paths{$to_plot}->get('file') . "\",\n" .
	              "          type=chi, group=". $paths{$to_plot}->get('group') . ")\n";
    };
    $plot_string .= plot($paths{$to_plot}->get('fit_space'), 1, 1);
    $paths{data0} -> dispose($plot_string, $dmode);

  };

  ## --- if there were some bad guess parameters ...
  if (@bad_params) {
    my $all = join("\n\t", @bad_params);
    my $these = ($#bad_params) ? 'these' : 'this';
    my $dialog =
      $top -> Dialog(-bitmap         => 'warning',
		     -text           => "The guess parameters:\n\t$all\ncould not be determined by the fit.\n\nShould Artemis change $these from guess to set?",
		     -title          => 'Artemis: Bad guess parameters...',
		     -buttons        => [qw/Yes No/],
		     -default_button => 'No',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    if ($response eq 'Yes') {
      foreach my $b (@bad_params) {
	G: foreach my $g (@gds) {
	    if (lc($b) eq lc($g->name)) {
	      $g->make(type=>"set");
	      last G;
	    };
	  };
	};
      repopulate_gds2();
      Echo("The ill-defined guess parameters were changed to set.  You might want to re-run the fit now.")
    };
  };

  ## --- almost done...
  $is_busy or $top->Unbusy;
  display_properties if $how;
  if ($warnings) {
    open W, ">".File::Spec->catfile($project_fit_dir, 'warnings');
    print W $warnings;
    close W;
    Error("Artemis found possible problems with the fit.  Check the \"Messages\" tab (Control-4) for details.");
    post_message($warnings, 'Fit warnings', 1);
    raise_palette('results');
    $update->raise;
  } elsif ($echo -> cget('-text') =~ /trap/) {
    1;
  } elsif ($echo -> cget('-text') =~ /ill-defined/) {
    1;
  } else {
    Echo(($how == 2) ?
	 "Making the sum of paths ... done!" :
	 "Running fit ... done!");
  };
  $log_params{force} = 1 if ($how_many =~ /sel/);
  project_state(0) if $how;
};



# swiped from the old Ifeffit::IO:
#   change (3,1,14,5,15,2,13,7,8,6,12) to "1-3,5-8,12-15"
sub normalize_paths {
  my @tmplist;                  # expand 'X-Y'
  map { push @tmplist, ($_ =~ /(\d+)-(\d+)/) ? $1 .. $2 : $_ } @{$_[0]};
  my @list   = grep /\d+/, @tmplist; # weed out non-integers
  @list      = sort {$a<=>$b} @list; # sort 'em
  my $this   = shift(@list);
  my $string = $this;
  my ($prev, $concat) = ('', '');
  while (@list) {
    $prev   = $this;
    $this      = shift(@list);
    if ($this == $prev+1) {
      $concat  = "-";
    } else {
      $concat  = ",";
      $string .= join("", "-", $prev, $concat, $this);
    };
    $prev = $this;
  };
  ($concat eq "-") and $string .= $concat . $this;
  return $string;
};


## this sorts the set parameter objects in an order such that the sets that
## depend on other sets are declared after the ones they depend upon.  The
## logic is this: $a is greater than $b if $a's math expression uses $b's name
## or else sort alphabetically by math expression (which puts the
## number-valued sets first)
sub byuse {
  ($a->mathexp =~ /\b$b->{name}\b/i) <=> ($b->mathexp =~ /\b$a->{name}\b/i)
    ||
  (lc($a->mathexp) cmp lc($b->mathexp))
};


sub fix_residuals {
  my $d = $_[0];
  my $g = $paths{$d}->get('group');
  if (lc($paths{$d}->get('fit_space')) eq 'k') {
    my @xarray = Ifeffit::get_array($g."_res.k");
    my @yarray = Ifeffit::get_array($g."_res.chi");
    my ($min, $max) = (0, $#xarray);
    foreach my $i (0 .. $#xarray) {
      next if (($xarray[$i] > $paths{$d}->get('rmin')) and
	       ($xarray[$i] < $paths{$d}->get('rmax')));
      $yarray[$i] = 0;
      ## ($min = $i-1), last if ($xarray[$i] > $paths{$d}->get('kmin'));
    };
    ## foreach my $i (reverse (0 .. $#xarray)) {
    ##  ($max = $i+1), last if  ($xarray[$i] < $paths{$d}->get('kmax'));
    ## };
    ## @xarray = splice(@xarray, $min, $max-$min+1);
    ## @yarray = splice(@yarray, $min, $max-$min+1);
    Ifeffit::put_array($g."_res.k",   \@xarray);
    Ifeffit::put_array($g."_res.chi", \@yarray);
  } elsif (lc($paths{$d}->get('fit_space')) eq 'r') {
    my @xarray = Ifeffit::get_array($g."_res.r");
    my @yarray = Ifeffit::get_array($g."_res.chir_re");
    my @zarray = Ifeffit::get_array($g."_res.chir_im");
    my ($min, $max) = (0, $#xarray);
    foreach my $i (0 .. $#xarray) {
      next if (($xarray[$i] > $paths{$d}->get('rmin')) and
	       ($xarray[$i] < $paths{$d}->get('rmax')));
      $yarray[$i]=EPSILON, $zarray[$i]=0;
      ## ($min = $i-1), last if ($xarray[$i] > $paths{$d}->get('rmin'));
    };
    ## foreach my $i (reverse (0 .. $#xarray)) {
    ##   ($max = $i+1), last if ($xarray[$i] < $paths{$d}->get('rmax'));
    ## };
    ## @xarray = splice(@xarray, $min, $max-$min+1);
    ## @yarray = splice(@yarray, $min, $max-$min+1);
    ## @zarray = splice(@zarray, $min, $max-$min+1);
    Ifeffit::put_array($g."_res.r",       \@xarray);
    Ifeffit::put_array($g."_res.chir_re", \@yarray);
    Ifeffit::put_array($g."_res.chir_im", \@zarray);
  } elsif (lc($paths{$d}->get('fit_space')) eq 'q') {
    my @xarray = Ifeffit::get_array($g."_res.q");
    my @yarray = Ifeffit::get_array($g."_res.chiq_re");
    my @zarray = Ifeffit::get_array($g."_res.chiq_im");
    my ($min, $max) = (0, $#xarray);
    foreach my $i (0 .. $#xarray) {
      next if (($xarray[$i] > $paths{$d}->get('rmin')) and
	       ($xarray[$i] < $paths{$d}->get('rmax')));
      $yarray[$i]=EPSILON, $zarray[$i]=0;
      ## ($min = $i-1), last if ($xarray[$i] > $paths{$d}->get('kmin'));
    };
    ## foreach my $i (reverse (0 .. $#xarray)) {
    ##   ($max = $i+1), last if  ($xarray[$i] < $paths{$d}->get('kmax'));
    ## };
    ## @xarray = splice(@xarray, $min, $max-$min+1);
    ## @zarray = splice(@zarray, $min, $max-$min+1);
    Ifeffit::put_array($g."_res.q",       \@xarray);
    Ifeffit::put_array($g."_res.chiq_re", \@yarray);
    Ifeffit::put_array($g."_res.chiq_im", \@zarray);
  };
};


sub erase_all_variables { &unguess };

sub unguess {
  return "unguess\n";
};

sub fit_toggle_new {
  my ($rpfd, $how) = @_;
  my $prev_label = "";
  if (-e File::Spec->catfile($project_folder, "fits",
			     sprintf("fit%4.4d", $fit{count}), 'label')) {
    open PL, File::Spec->catfile($project_folder, "fits",
				 sprintf("fit%4.4d", $fit{count}), 'label');
    $prev_label = <PL>;
    close PL;
  };
  ($prev_label =~ s/\bsum\b/fit/) if ($how == 1);
  ($prev_label =~ s/\bfit\b/sum/) if ($how == 2);

  ## get the previous fit count number and set $fit{count} according
  ## to how it is being toggled.
  opendir F, File::Spec->catfile($project_folder, "fits");
  my @fits = sort( grep {/fit\d+/ and -d  File::Spec->catfile($project_folder, "fits", $_)} readdir(F) );
  closedir F;
  my $prev = sprintf("%d", substr($fits[$#fits],3));
  if ($fit{new}) {
    $fit{count} = $prev+1;
  } else {
    $fit{count} = $prev;
  };
  ## only fix the label and comment if the user is sticking with the
  ## defaults, don't change them is they appear to be user chosen
  if ($fit{label} =~ /^(fit|sum)\s+\d+$/) {
    $fit{label}     = $prev_label;
    $fit{label}   ||= ($how == 1) ? "fit $fit{count}"  : "sum $fit{count}";
    $fit{label}    =~ s/\b$prev\b/$fit{count}/g;
  };
##   if ($fit{comment} =~ /^(Fit|Sum)\s+\#\d+$/) {
##     $fit{comment}   = $props{Comment};
##     ($fit{comment} =~ s/\bSummation\b/Fit/) if ($how == 1);
##     ($fit{comment} =~ s/\bFit\b/Sum/) if ($how == 2);
##     $fit{comment} ||= ($how == 1) ? "Fit #$fit{count}" : "Summation #$fit{count}";
##     $fit{comment}  =~ s/\b$prev\b/$fit{count}/g;
##   };
  $fit{fom} = $fit{count};
  $$rpfd = File::Spec->catfile($project_folder, "fits",
			       sprintf("fit%4.4d", $fit{count}));
};

##  END OF THE FITTING SUBSECTION

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##

###===================================================================
### plotting subsystem
###===================================================================

sub plot {
  my $data = $paths{$current}->data;
  #unless ($list -> info('exists', $paths{$data}->{id}.".0")) {
  Echo("You're last plot was an Energy plot."), return "" if (lc($_[0]) eq 'e');
  Echo("You have not opened a data file or a feff calculation yet."), return ""
    unless ($n_data or $n_feff);
  #};
  ## need a foreach loop for multiple data sets
  my ($data_requested, $data_there) = (0, 1);
  foreach my $d ($list->info('selection')) {
    next unless (ref($paths{$d}) =~ /Ifeffit/);
    next unless ($paths{$d}->type =~ /(bkg|data|diff|fit|res)/);
    ++$data_requested;
    if ($paths{$d}->type eq 'data') {
      $data_there &&= ((-e $paths{$d}->get('file')) or ($paths{$d}->get('file') eq ""));
    } else {
      my $this = $paths{$d}->data;
      $data_there &&= ((-e $paths{$this}->get('file')) or ($paths{$this}->get('file') eq ""));
    };
  };
  ## if ($data_requested and $n_data and (not $data_there)) {
  ##     Echo("You have not yet loaded data or your data file does not exist.  Try \"Change data file\" in the Data menu.");
  ##     return "";
  ##   };
  ## this is flawed (do a foreach loop)
  my $feff_requested = grep(/(feff\d+)\.\d+/, $list->info('selection'));
  my $feffinp_exist  = 0;
  foreach ($list->info('selection')) {
    next unless (ref($paths{$_}) =~ /Ifeffit/);
    next unless ($paths{$_}->type eq 'path');
    $feffinp_exist ||= (-e $paths{$_}->get("feff.inp"));
  };
  if ($feff_requested and $n_feff and not $feffinp_exist) {
    Echo("Your feff calculation does not exist.  Perhaps you chould change the path.");
    return "";
  };
  if (not $feff_requested and not $data_requested) {
    #Echo("You have not selected any form of data or any paths for plotting.");
    #return "";
    my $first = &first_data;
    $list->selectionClear;
    $list->selectionSet($first);
    $list->selectionSet($list->info('next', $first));
  };
  my $space = lc($_[0]);
  Echo("Plotting in $space space ... ") unless $_[1];
  my $after_fit = $_[2];
  $top -> Busy();
  my $command = '';

  my $param_err .= &verify_data_parameters;
  if ($param_err) {
    $param_err = "There were errors among the data parameters:\n\n" . $param_err;
    post_message($param_err, "Error Messages");
    Error("plot aborted due to errors in data parameters");
    $top->Unbusy;
    return;
  };

  ## need variables for paths
  if ($feff_requested) {
    my $error = "";
    $error   .= &verify_parens;
    if ($error) {
      post_message($error, "Error Messages");
      Error("plot aborted due to errors in math expressions");
      $top->Unbusy;
      return;
    };
    ##$command .= &erase_all_variables;
    ##&read_gsd(1);			# update gsd object
    if ($parameters_changed) {
      map { $command .= $_ -> write_gsd } (@gds);
      $parameters_changed = 0;
    };
  };

  ## before plotting, adjust the selection so that if the head of a
  ## fit branch is requested for plotting, it is deselected and the
  ## latest fit is selected instead
  foreach my $p ($list->info('selection')) {
    next unless ($paths{$p}->type eq 'fit');
    next if $paths{$p}->get('parent');
    next unless $paths{$p}->get('thisfit'); # this keeps it from
                                            # plotzing when writing a
                                            # script without actually
                                            # running
    $list->selectionClear($p);
    $list->selectionSet($paths{$p}->get('thisfit'));
  };
  $top -> update;

 SWITCH: {
    ($space eq 'k') and do {
      $command .= $paths{$data} -> plot_k($list, \%plot_features, \@extra, $stash_dir);
      $last_plot = 'k';
      last SWITCH;
    };
    ($space eq 'r') and do {
      $command .= $paths{$data} -> plot_R($list, \%plot_features, \@extra, $stash_dir);
      $last_plot = 'r';
      last SWITCH;
    };
    ($space eq 'q') and do {
      $command .= $paths{$data} -> plot_q($list, \%plot_features, \@extra, $stash_dir);
      $last_plot = 'q';
      last SWITCH;
    };
    $command .= $paths{$data} -> plot_R($list, \%plot_features, \@extra, $stash_dir);
    $last_plot = 'r';
  };
  return $command if $_[1];

  #$notebook -> raise('ifeffit');
  $paths{gsd} -> dispose($command, $dmode);
  $paths{gsd} -> dispose($extra[6], $dmode) if $extra[5]; # indicators
  $extra[6] = "";
  #$config{general}{plot_tab} and $plotsel -> raise($space);

  $top->Unbusy;
  $command and Echo(@done);

};


sub replot {
  my $mode = $_[0];		# replot, print, or device_type
  Echo("You have not yet plotted anything."), return 0 unless ($last_plot);
  my ($title, $suf, $dev);
 SWITCH: {
      ($mode eq 'replot') and do {
	$paths{gsd}->dispose($Ifeffit::Path::last_plot_command, 1);
	Echo("Unzoomed.");
	return;
      };
      ($mode =~ /(gif|png)/) and do {
	($title, $suf, $dev) = ('Artemis: '.uc($1).' file name', $1, $mode );
	last SWITCH;
      };
      ($mode =~ /ps/) and do {
	($title, $suf, $dev) = ('Artemis: Postscript file name', 'ps', $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 = '...artemis.tmp';
      $paths{gsd}->dispose("plot(device=\"$dev\", file=\"$tmp\")\n", 7);
      local $| = 1;
      my $to = $config{general}{print_spooler};
      Echo("Sending image to printer via the  \"$to\" command");
      open OUT, "| $to" or
	die "could not open pipe to $to\n";
      open IN, $tmp or die "could not open temp file for printing";
      while (<IN>) { print OUT; };
      close IN; close OUT; unlink $tmp;
    };
    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=>"artemis.$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, $pth, $suffix) = fileparse($file);
      $current_data_dir = $pth;
      Echo("saving image to $file");
      $paths{gsd}->dispose("plot(device=\"$dev\", file=\"$file\")\n", 7);
    };
  };
};


sub zoom {
  Echo('No data'), return unless $current;
  Echo("You have not yet plotted anything."),
    return unless $last_plot;
  Echo('Click corners to zoom');
  $paths{gsd}->dispose('zoom', 1);
  Echo('Zooming done!');
};

sub cursor {
  Echo('No data'), return unless $current;
  Echo("You have not yet plotted anything."),
    return unless $last_plot;
  Echo('Click on a point');
  $paths{gsd}->dispose('cursor(crosshair=true)', 1);
  Echo(sprintf("You selected  x=%f   y=%f",
	       Ifeffit::get_scalar("cursor_x"),
	       Ifeffit::get_scalar("cursor_y")));
};



sub keyboard_plot {
  my $who = $top->focusCurrent;
  $multikey = "";
  Echo("Plot Current group: specify plot space (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) =~ /^[kqr]$/);
 SWITCH: {
    &plot('k', 0), last SWITCH if (lc($multikey) eq 'k');
    &plot('r', 0), last SWITCH if (lc($multikey) eq 'r');
    &plot('q', 0), last SWITCH if (lc($multikey) eq 'q');
  };
};


sub select_all {
  foreach my $p (keys %paths) {
    next unless (ref($paths{$p}) =~ /Ifeffit/);
    my $pp = $p;
    ## ($pp = $1 . "_" . ("fit", "res", "bkg")[$2]) if $p =~ /(data\d)\.(\d)/;
    next if ($paths{$pp}->type eq 'feff');
    next if ($paths{$pp}->type eq 'gsd');
    next unless ($list->infoExists($paths{$p}->get('id')));
    next if (($paths{$pp}->type eq 'path') and not ($paths{$pp}->get('include')));
    $list -> selectionSet($paths{$p}->get('id'));
  };
};


sub deselect_all {
  $list -> selectionClear;
  $list -> selectionSet($current);
  $list -> anchorSet($current);
};

## END OF THE PLOTTING SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##



###===================================================================
### project file (zip-based) subsystem
###===================================================================


sub initialize_project {
  my $do_search = $_[0];
  ## need to make name unique in case of multiple instances of Artemis.
  ## the project_folder global variable should suffice to disambiguate
  ## the multiple instances.
  my $instance = 0;
  my $project_dir = File::Spec->catfile($stash_dir, "artemis.project.$instance", "");
  unless (same_directory($project_folder, $project_dir)) {
    while (-d $project_dir) {
      ++$instance;
      $project_dir = File::Spec->catfile($stash_dir, "artemis.project.$instance", "");
    };
    if (($instance > 3) and ($do_search)) {
      my $dialog =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => "There seem to be a large number of abandoned project folders.  Project folders can be abandoned when Artemis exits abnormally.\n\nArtemis can clean these up at this time.\n\nYou should NOT clean these up if you have other active instances of Artemis running.",
		       -title          => 'Artemis: Question...',
		       -buttons        => ['Clean up',
					   "Don't clean up"],
		       -default_button => 'Cancel',
		       -font           => $config{fonts}{med},
		       -popover        => 'cursor');
      &posted_Dialog;
      $top -> deiconify;
      $top -> raise;
      my $response = $dialog->Show;
      if ($response eq 'Clean up') {
	Echo("Cleaning up adndoned project folders");
        opendir S, $stash_dir;
	map { rmtree(File::Spec->catfile($stash_dir, $_)) } (grep(/artemis\.project/, readdir S));
	closedir S;
	$project_dir = File::Spec->catfile($stash_dir, "artemis.project.0", "");
      };
      Echo("");
    };
    mkpath $project_dir unless (-d $project_dir);
    $project_folder = $project_dir;
  };
  ## one trailing slash of the correct variety...
  if ($is_windows) {
    ($project_folder .= "\\") unless ($project_folder =~ /\\$/);
  } else {
    ($project_folder .= "/") unless ($project_folder =~ /\/$/);
  };
  $props{'Project location'} = $project_dir;
  ## touch the marker file
  unless (-f File::Spec->catfile($project_dir, "HORAE")) {
    open A, ">".File::Spec->catfile($project_dir, "HORAE");
    #print A " \n";
    close A;
  };
  ## copy the readme file
  my $readme_file = $paths{data0} -> find('artemis', 'readme');
  copy($readme_file, File::Spec->catfile($project_dir, "README")) if (-e $readme_file);
  if ($is_windows) {
    require Win32::File;
    Win32::File::SetAttributes(File::Spec->catfile($project_dir, "README"), 0);
  };
  ## make the descriptions directory
  my $project_descr_dir = File::Spec->catfile($project_folder, "descriptions");
  mkpath $project_descr_dir unless (-d $project_descr_dir);
  ## make the data directory
  my $project_data_dir = File::Spec->catfile($project_folder, "chi_data");
  mkpath $project_data_dir unless (-d $project_data_dir);
  ## make the log files directory
  my $project_log_dir = File::Spec->catfile($project_folder, "log_files");
  mkpath $project_log_dir unless (-d $project_log_dir);
  ## make the tmp directory
  my $project_tmp_dir = File::Spec->catfile($project_folder, "tmp");
  mkpath $project_tmp_dir unless (-d $project_tmp_dir);
  ## make the fits directory
  my $project_fit_dir = File::Spec->catfile($project_folder, "fits");
  mkpath $project_fit_dir unless (-d $project_fit_dir);
  ## determine the autosave filename
  $autosave_filename = File::Spec->catfile($stash_dir, "artemis.autosave");
};

sub clean_old_trap_files {
  opendir S, $stash_dir;
  my @list = grep {/ARTEMIS/} readdir S;
  closedir S;
  map {unlink File::Spec->catfile($stash_dir, $_)} @list;
};


## make a project feff folder
sub initialize_feff {
  my $id = $_[0];
  my $project_feff_dir = File::Spec->catfile($project_folder, $id);
  mkpath $project_feff_dir unless (-d $project_feff_dir);
  return $project_feff_dir;
};


sub unpack_zip {
  Echo("Opening project zipfile $_[0] ...");
  ## check to see if it seems as though a project has started
  ##   system "ls -R /home/bruce/.horae/stash/";
  ##   opendir P, $project_folder;
  ##   my @dirs = grep {$_ !~ /^\./ and -d $_} (readdir P);
  ##   closedir P;
  ##   my $i = 0;
  ##   find( sub{ ++$i if -f; print $_, $/ }, @dirs );
  ##   print $i, $/;
  if (($paths{data0}->get('file') and (-e $paths{data0}->get('file'))) or
      (&all_feff)) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "You have already started a project.  Do you want to discard the current project and replace it with this one?  Or do you want to cancel the import of this project?  (Merging projects is not currently supported.)",
		     -title          => 'Artemis: Question...',
		     -buttons        => ['Replace', 'Cancel'],
		     -default_button => 'Cancel',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    Echo("Aborting project file"), return 1 if ($dialog->Show() eq 'Cancel');
    Echo("");
    &delete_project;
  };

  my ($zip, $name);
  #if (ref $_[0] =~ /Archive/) {
  #  $zip = $_[0];
  #} else {
    $zip = Archive::Zip->new();
    Echo('Error reading project file $_[0]'), return 1 unless ($zip->read($_[0]) == AZ_OK);
    $name = &push_mru($_[0], 1, "project") || $_[0];
  #};
  $zip->extractTree("", $project_folder);
  undef $zip;
  Echo("Opening project zipfile $name ... done!");
  return 0;
};


sub zip_project {
  my $proj = $_[0];
  my $zip = Archive::Zip->new();
  $zip->addTree( $project_folder, "" );
  die 'error writing zip-style project' unless $zip->writeToFileNamed( $proj ) == AZ_OK;
  undef $zip;
};

sub convert_project_to_zip {

  my $stash = $_[0];
  Echo("Converting old-style project file to the zip format ... ");

  &initialize_project(0);
  ## copy the old-style project file to the description file in the
  ## stash directory
  copy($stash, File::Spec->catfile($project_folder, "descriptions", 'artemis'));


  open PROJ, $stash or die "could not open $stash as a project file\n";

  $top -> Busy();
  my $cpt = new Safe;
  #use vars qw($old_path @args @strings @journal @plot_features);
  my $from_version = 0;
  while (<PROJ>) {
    next unless (/^\@args/);
    @ {$cpt->varglob('args')} = $cpt->reval($_);
    ## this is a little fast 'n' loose, but the args array is stored in
    ## a form that can be read directly into a hash, so ...
    my %args = @ {$cpt->varglob('args')};
    ## copy the data files into the data folder
    if ($args{type} eq 'data') {
      unless ($args{file} =~ /^\s*$/) {
	unless (-f $args{file}) {
	  my $dialog =
	    $top -> Dialog(-bitmap         => 'questhead',
			   -text           => "The file $args{file} does not seem to exist.  Artemis will now prompt you for the real location of this file.",
			   -title          => 'Artemis: Problem finding a data file ...',
			   -buttons        => ['OK', 'Cancel'],
			   -default_button => 'OK',
			   -font           => $config{fonts}{med},
			   -popover        => 'cursor');
	  &posted_Dialog;
	  my $response = $dialog->Show();
	  if ($response eq 'Cancel') {
	    rmtree($project_folder);
	    $project_folder = "";
	    $top -> Unbusy();
	    Echo("Project aborted.");
	    return 0;
	  };
	  Echo("");
	  my $path = $current_data_dir || cwd;
	  my $types = [['chi(k) data',      '*.chi'],
		       ['All files',        '*'],];
	  my $file ||= $top -> getOpenFile(-filetypes=>$types,
					   ##(not $is_windows) ?
					   ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
					   -initialdir=>$path,
					   -title => "Artemis: Open a data file");
	  unless ($file) {
	    rmtree($project_folder);
	    $project_folder = "";
	    $top -> Unbusy();
	    Echo("Project aborted.");
	    return 0;
	  };
	  push_mru($file);
	  $args{file} = $file;
	};
	copy($args{file}, File::Spec->catfile($project_folder, "chi_data"));
      };
    ## copy the feff calculations into feff folders
    } elsif ($args{type} eq 'feff') {
      my $project_feff_dir = File::Spec->catfile($project_folder, $args{id});
      mkpath $project_feff_dir unless (-d $project_feff_dir);
      unless ((-d $args{path}) and (-f $args{'feff.inp'})) {
	my $dialog =
	  $top -> Dialog(-bitmap         => 'questhead',
			 -text           => "The Feff calculation which used $args{'feff.inp'} does not seem to exist.  Artemis will now prompt you for the correct directory.",
			 -title          => 'Artemis: Problem finding a data file ...',
			 -buttons        => ['OK', 'Cancel'],
			 -default_button => 'OK',
			 -font           => $config{fonts}{med},
			 -popover        => 'cursor');
	&posted_Dialog;
	my $response = $dialog->Show();
	if ($response eq 'Cancel') {
	  rmtree($project_folder);
	  $project_folder = "";
	  $top -> Unbusy();
	  Echo("Project aborted.");
	  return 0;
	};
	Echo("");
	my $dir = q{};
	if ($Tk::VERSION < 804) {
	  $top -> Dialog(-bitmap  => 'error',
			 -text    => "Selecting folders requires perl/Tk 804.  You are using perl/Tk $Tk::VERSION.  Drat!",
			 -title   => 'Artemis: Unable to change folders',
			 -buttons => ['OK'],
			 -font           => $config{fonts}{med},
			 -default_button => "OK", )
	    -> Show();
	  #$dir = $top -> DirSelect(-width=>40, -dir=>$current_data_dir,
		#		   -title=> "Artemis: Select a directory",
		#		   -text => "Select the correct path to your FEFF calculation",
		#		  ) -> Show;
	} else {
	  $dir = $top -> chooseDirectory(-initialdir => $current_data_dir,
					 -title	=> "Artemis: Select a directory",
				    #-mustexist	=> 1,
				   );
	};
	unless ($dir) {
	  rmtree($project_folder);
	  $project_folder = "";
	  $top -> Unbusy();
	  Echo("Project aborted.");
	  return 0;
	};
	$current_data_dir = $dir;
	$args{path} = $dir;
      };
      opendir FFF, $args{path};
      my @list = grep { -f File::Spec->catfile($args{path},$_) } readdir FFF;
      closedir FFF;
      map { copy(File::Spec->catfile($args{path},$_), $project_feff_dir) } @list;
    };
  };
  close PROJ;

  ## backup the old-style project file for safe keeping
  rename($stash, $stash.".oldstyle");
  ## save the project as a zip file
  my $zip = Archive::Zip->new();
  $zip->addTree( $project_folder, "" );
  die 'write error' unless $zip->writeToFileNamed( $stash ) == AZ_OK;
  undef $zip;
  ## clean up the stash folder.  this is perhaps a bit silly since it
  ## will soon be opened up again, but doing it this was will not
  ## require special code.
  rmtree($project_folder);
  $project_folder = "";
  &initialize_project(0);
  $top -> Unbusy();
  Echo("Converting old-style project file to the zip format ... done!");
  return 1;

};





## END OF THE PROJECT FILE (ZIP-BASED) SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006, 2008, 2010 Bruce Ravel
##



###===================================================================
### project description subsystem
###===================================================================

## arg 1: flag for querying user for a file name
## arg 2: autosave flag
sub save_project {
  my ($query, $auto) = @_;
  ##local $Tk::FBox::a;
  ##local $Tk::FBox::b;

  ## --- respond to an autosave event
  ##     autosave disabled
  return if ($auto and (lc($config{general}{autosave_policy}) eq 'none'));
  ##     realsave rather than autosave
  ($auto = 0) if ($auto and (lc($config{general}{autosave_policy}) eq 'realsave'));
  my $file;
  if ($auto) {
    $file = $autosave_filename;
    Echo("Performing autosave ...");
  } elsif ($query or (not $project_name)) {
    my $path = $current_data_dir || cwd;
    my ($init, $suffix) = ('artemis.apj', '');
    ($init, $path, $suffix) = fileparse($project_name) if $project_name;
    my $types = [['Artemis projects', '.apj'],
		 ['All Files', '*'],];
    $file = $top -> getSaveFile(-filetypes=>$types,
				##(not $is_windows) ?
				##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$path,
				-initialfile=>$init,
				-title => "Artemis: Save project");
    return unless ($file);
    my $name = &push_mru($file, 1, "project");
    #my ($name, $pth, $suff) = fileparse($file);
    #$current_data_dir = $pth;
    $project_name = $file;	# reset deault project name
    Echo("Saving project ...");
  } else {
    $file = $project_name;
    Echo("Saving project ...");
  };

  my $dir = dirname($file);
  if (-e $dir and -w $dir) {
    Error("Cannot write to \"$file\".  Check the permissions of that file or directory."), return if (-e $file and not -w $file);
  };

  $top -> Busy;

  if (($paths{$current}->type eq 'feff') and ($paths{$current}->{mode} > 1)) {
    ## save the feff.inp file
    my $feff_file = File::Spec->catfile($project_folder, $paths{$current}->get('id'), "feff.inp");
    Echo("Saving feff.inp file");
    $widgets{feff_inptext} -> Save($feff_file);
  };

  read_titles if ($current_canvas eq 'op');

  my $description = &save_description;
  ##@-fp-@ save_fingerprint($description);

  ## save the journal
  open J, ">".File::Spec->catfile($project_folder, "descriptions", "journal.artemis");
  print J $notes{journal}->get(qw(1.0 end));
  close J;

  ## zip up project folder
  &zip_project($file);
  $top -> Unbusy;
  if ($auto) {
    Echo("Performing autosave ... done!");
  } else {
    unlink $autosave_filename, Echo("Removed stale autosave file.")
      if (-e $autosave_filename);
    Echo("Saved project to $file.");
  };
  project_state(1) unless $auto;
};

sub save_description {
  $Data::Dumper::Indent = 0;

  my $description = File::Spec->catfile($project_folder, 'descriptions', 'artemis');

  ## keep one level of backup
  ##rename($description, $description.".bak") if (-f $description);

  open PROJ, ">".$description or do {
    Error("You cannot write the artemis description file."); return
  };
  print PROJ "# Artemis project file -- Artemis version $Ifeffit::Path::VERSION\n";
  print PROJ $paths{data0} -> project_header($project_folder);

  ### loop over all data and save parameters and titles
  ##my @data = ('gsd', &every_data);
  my @data = (&every_data);
  foreach my $p (@data) {
    my @titles;
    if ($paths{$p}->type eq 'data') {
      foreach my $t (split(/\n/, $paths{$p}->get('titles'))) {
	push @titles, $t;
      };
    };
    my @args;
    foreach my $k (keys %{$paths{$p}}) {
      next if ($k eq 'titles');
      next if ($k eq 'inc_mapping');
      next if ($k eq 'included');
      next if ($k eq 'from_project');
      next if ($k eq 'autoparams');
      next if ($k eq 'family');
      next if ($k =~ 'do_[krq]');
      ## these next two prevent saving difference spectrum information
      ## to the project
      next if ($k =~ 'diff_(list|mapping|paths)');
      next if ($k =~ '(fit|made)_diff');
      push @args, $k, $paths{$p}->get($k);
    };
    print PROJ
      Data::Dumper->Dump([$p], [qw/old_path/]),    $/,
      Data::Dumper->Dump([\@args],   [qw/*args/]), $/;
    ($p =~ /^data\d+$/) and print PROJ Data::Dumper->Dump([\@titles], [qw/*strings/]), $/;
    print PROJ "[record]", $/, $/;
  };

  ##my @allkeys = (keys %paths);
  my @allkeys = &path_list;
  ## save the feff's and paths
  foreach my $path (&all_feff) {
    # my $path = "data" . $nd . ".feff" . $nf;
    next unless (exists $paths{$path});
    my @args;
    foreach my $k (keys %{$paths{$path}}) { # save the feff parent
      next if ($k eq 'titles');
      next if ($k eq 'intrp');
      next if ($k eq 'from_project');
      next if ($k eq 'family');
      push @args, $k, $paths{$path}->get($k);
    };
    print PROJ
      Data::Dumper->Dump([$path], [qw/old_path/]), $/,
      Data::Dumper->Dump([\@args], [qw/*args/]),   $/,
      "[record]", $/, $/;
    #my @paths = grep {/feff$nf\.\d+/} @allkeys;
    my @paths = grep {/$path\.\d+/} @allkeys;
    # and save all the path children of this parent
    foreach my $p (@paths) {
      my @args;
      foreach my $k (keys %{$paths{$p}}) {
	next if ($k eq 'titles');
	next if ($k eq 'header');
	next if ($k eq 'group');
	next if ($k eq 'fit_index');
	next if ($k eq 'from_project');
	next if ($k eq 'family');
	push @args, $k, $paths{$p}->get($k);
      };
      my @header;		# save headers separately
      foreach my $h (split(/\n/, $paths{$p}->get('header'))) {
	push @header, $h;
      };
      print PROJ
	Data::Dumper->Dump([$p],       [qw/old_path/]), $/,
	Data::Dumper->Dump([\@args],   [qw/*args/]),    $/,
	Data::Dumper->Dump([\@header], [qw/*strings/]),  $/,
	"[record]", $/, $/;
    };
  };

  ## save the parameter list
  foreach my $p (@gds) {
    printf PROJ ("\@parameter = ('%s','%s','%s','%s',%d);\n",
		 $p->name, $p->type, $p->mathexp, $p->note, $p->autonote);
  };
  print PROJ "\n";

  ## save the plotting options
  print PROJ Data::Dumper->Dump([\%plot_features], [qw/*plot_features/]), $/, $/;

  ## save the extra plotting features
  my @this;
  @this[0..5] = @extra[0..5];
  $this[5] = "";
  foreach (7 .. $#extra) {
    $this[$_]->[0] = $extra[$_]->[1];
    $this[$_]->[1] = $extra[$_]->[2];
  };
  print PROJ Data::Dumper->Dump([\@this], [qw/*extra/]), $/, $/;

  ##   my @journal;
  ##   foreach my $j (split(/\n/, $notes{journal}->get(qw(1.0 end)))) {
  ##     push @journal, $j;
  ##   };
  ##   print PROJ Data::Dumper->Dump([\@journal], [qw/*journal/]), $/, $/;

  ## save the properties
  print PROJ Data::Dumper->Dump([\%props], [qw/*props/]), $/, $/;

  print PROJ "\n1;\n# Local Variables:\n# truncate-lines: t\n# End:\n";
  close PROJ;
  $Data::Dumper::Indent = 2;
  return $description;

};

sub save_fingerprint {
  my $description = $_[0];
  local( $/, *P );
  open( P, $description ) or die "could not open $description for fingerprinting\n";
  my $fingerprint = md5_hex(<P>);
  close P;
  my $folder = dirname($description);
  open F, ">".File::Spec->catfile($folder, '...fp');
  print F $fingerprint;
  close F;
};

sub compare_fingerprint {
  my ($fp_file, $description) = @_;
  open( F, $fp_file ) or die "could not open $description for fp_file\n";
  my $prior = <F>;
  close F;
  open( D, $description ) or die "could not open $description for fingerprinting\n";
  my $this = md5_hex(<D>);
  close D;
  ##print "  $prior  $this\n";
  return ($prior eq $this);
};


## check to see if arg is a zip-style project
sub is_project {
  return 0;
};


## check the first line of a file to verify that it is a record
## (i.e. old-style project)
sub is_old_project {
  my $file = $_[0];
  open F, $file or die "could not open $file as an Artemis project\n";
  my $first = <F>;
  close F;
  return ($first =~ /Artemis project file/) ? 1 : 0;
};

sub is_athena_record {
  my $file = $_[0];
  open F, $file or die "could not open $file as an Athena record\n";
  my $first = <F>;
  close F;
  if ($first =~ /Athena project file/) {
    return -1;
  } elsif ($first =~ /Athena record file/) {
    return 1;
  } else {
    return 0;
  };
};




sub date_of_file {
  my $month = (qw/January February March April May June July
	          August September October November December/)[(localtime)[4]];
  my $year = 1900 + (localtime)[5];
  return sprintf "This file created at %2.2u:%2.2u:%2.2u on %s %s, %s",
    reverse((localtime)[0..2]), (localtime)[3], $month, $year;
  # ^^^ this gives hour:min:sec
};


sub open_project {
  my $file = $_[0];
  #my ($name, $pth, $suffix) = fileparse($file);
  #$current_data_dir = $pth;
  ## activate op widgets
  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'normal')} (keys %widgets);
  map {$grab{$_}->configure(-state=>'normal')} (keys %grab);

  my $is_busy = grep (/Busy/, $top->bindtags);
  $top -> Busy unless $is_busy;
  my $from_version;
  if ($is_windows) {
    Echo("Reading project file with direct evaluations");
    $from_version = read_record_on_windows($file);
  } else {
    Echo("Reading project file in a safe compartment");
    $from_version = read_record($file)
  };
  ## set $n_feff to one larger than the largest index used in this
  ## project
  my $nn = 0;
  opendir P, $project_folder;
  foreach (readdir P) {
    next unless (/data\d+\.feff(\d)/);
    ($nn = $1) if ($1 > $nn);
  };
  closedir P;
  ++$nn;
  $n_feff = $nn;

  ## read journal into the journal space
  do {
    local $/ = undef;
    open J, File::Spec->catfile($project_folder, "descriptions", "journal.artemis");
    $notes{journal}->insert('1.0', <J>);
    close J;
  };

  ## insert sets and guesses
  repopulate_gds2();

  ## try to clean up the problem of null entries
  foreach my $p (keys %paths) {
    next if (ref($paths{$p}) =~ /Ifeffit/);
    delete $paths{$p};
    Echo("Null path $p discarded.");
  };
  foreach my $d (keys %paths) {
    next if ($paths{$d}->type =~ /(feff|gsd|path)/);
    #next unless ($paths{$d}->type =~ /(bkg|data|diff|fit|res)/);
    $paths{$d} -> make(do_k=>1);
  };
  foreach my $p (keys %paths) {	 # flag paths for updating
    next unless ($paths{$p}->type eq 'path');
    $paths{$p} -> make(do_k=>1);
  };

  unless ($from_version =~ /DR/) {
    # fix up order of paths for projects from before 0.5.002
    if (($from_version < 0.5002) or ($from_version > 2000)) {
      Echo("Fixing project file from before version 0.5.002");
      my @allkeys = (keys %paths);
      my @feffs = grep {/feff\d+$/} @allkeys;
      foreach my $f (@feffs) {
	my $n = substr($f, 4);
	my @paths = grep {/feff$n\.\d+/} @allkeys;
	@paths = sort {$paths{$a}->get('lab') cmp $paths{$b}->get('lab')} @paths;
	my @cache;
	foreach my $p (@paths) {	# remember the mapping between the old and new objects
	  push @cache, $paths{$p};
	};
	foreach my $p (@paths) {	# delete 'em all from the list
	  $list -> delete('entry', $p);
	};
	foreach my $p (@paths) {	# replace 'em all in the list and map old to new
	  my $kid = $list ->
	    addchild($f, -text=>$paths{$p}->get('lab'),
		     -style=>$list_styles{$paths{$p}->pathstate});
	  $paths{$kid} = shift @cache;
	  $paths{$kid} -> make(id=>$kid);
	};
	foreach my $p (@paths) {	# get rid of the old objects
	  delete $paths{$p};
	};
      };
      Echo("Fixing project file from before version 0.5.002 ... done!");
    };
  };

  $fefftabs -> raise("Interpretation");

  ## --- look for situation of a fits/fits0001 folder that is not a
  ##     real project fit folder from 0.7.010
  my $is_old_fits = 1;
  $is_old_fits = 0 if ($from_version =~ /DR/);
  $is_old_fits = 0 if ($from_version =~ /^0.8/);
  if ($is_old_fits and (-d File::Spec->catfile($project_folder, "fits", "fit0001"))) {
    Echo("Cleaning up fit directory from an old version of Artemis that does not support fit history.");
    rmtree(File::Spec->catfile($project_folder, "fits", "fit0001"), 0, 0);
  };

  ## --- is this project old enough not to have a tmp/ folder?
  mkdir File::Spec->catfile($project_folder, "tmp") unless (-d File::Spec->catfile($project_folder, "tmp"));

  ## --- is this project old enough not to have a readme file?
  my $readme_file = $paths{data0} -> find('artemis', 'readme');
  copy($readme_file, File::Spec->catfile($project_folder, "README"))
    if ((-e $readme_file) and (! -e File::Spec->catfile($project_folder, "README")));

  ## --- look for old fits in the fits folder
  opendir F, File::Spec->catfile($project_folder, "fits");
  my @fits = sort( grep {/fit\d+/ and -d  File::Spec->catfile($project_folder, "fits", $_)} readdir(F) );
  closedir F;

  ## restore label to the fit branch according to whether the last
  ## operation involving this data set was a fit or a sum
  if (@fits) {
    foreach my $d (&all_data) {
      my $fsfile = File::Spec->catfile($project_folder, "fits", $fits[$#fits], "$d.fs");
      my $lastfit = 'fit';
      if (-e $fsfile) {
	open FS, $fsfile;
	$lastfit = <FS>;
	$lastfit =~ s/\s$//;	# remove the carriage return if it's there
	close FS;
      };
      $list -> entryconfigure($d.".0", -text=>($lastfit =~ /fit/) ? "Fit" : "Sum");
    };
  };

  foreach my $f (@fits) {
    open L, File::Spec->catfile($project_folder, "fits", $f, 'label');
    my $label = <L>;
    $label =~ s/\s$//;	# remove the carriage return if it's there
    close L;
    $fit{count} = sprintf("%d", substr($f,3));
    $fit{count_full} ||= $fit{count};
    my $log = Ifeffit::ArtemisLog -> new(File::Spec->catfile($project_folder, "fits", $f, 'log'));

    foreach my $d (&all_data) {
      ##$list -> entryconfigure($d.".0", -text=>"Fit [$fit{count_full}]");
      my $fname = $d . ".fit";
      ## handle situation of this data not having this fit
      next unless (-e File::Spec->catfile($project_folder, "fits", $f, $fname));
      $paths{$d.'.0'} ||=  Ifeffit::Path -> new(id     => $d.".0",
						type   => 'fit',
						group  => $d.'_fit',
						sameas => $d,
						lab    => 'Fit',
						parent => 0,
						family => \%paths);
      $list -> show('entry', $d.".0");
      ##my $id = $list->addchild($d.".0");
      $list->add($d.".0.".$fit{count});
      my $id = $d.".0.".$fit{count};
      $paths{$id} = Ifeffit::Path -> new(id	  => $id,
					 type     => 'fit',
					 group    => $d.'_fit_'.$fit{count},
					 sameas   => $d,
					 lab	  => $label,
					 value    => $log->get('Figure of merit') || 0,
					 folder   => $f,
					 filename => $fname,
					 parent   => $d.".0",
					 family   => \%paths);
      $paths{$d.".0"} -> make(thisfit=>$id);
      $list -> entryconfigure($id, -style=>$list_styles{enabled}, -text=>$label);
      $paths{$id} -> make(fitfile=>File::Spec->catfile($project_folder, "fits", $f, $fname));
      my $bname = File::Spec->catfile($project_folder, "fits", $f, $d.".bkg");
      $paths{$id} -> make(bkgfile=>(-e $bname) ? $bname : "");
      $paths{$id} -> make(resfile=>File::Spec->catfile($project_folder, "fits", $f, $d.".res"));
      ## restore FT and fit parameters
      my $ftfile = File::Spec->catfile($project_folder, "fits", $f, $d.".FT");
      if (-e $ftfile) {
	open FT, $ftfile;
	foreach (<FT>) {
	  chomp;
	  my ($k, $v) = split(/=/, $_);
	  $v =~ s/\s//g;	# remove the carriage return if it's there
	  $paths{$id} -> make($k=>$v);
	};
	close FT;
      } else { # this is a project from before the FT file existed, so
               # use the corresponding data's parameters
	foreach my $k (qw(kmin kmax dk kwindow rmin rmax dr rwindow)) {
	  $paths{$id} -> make($k => $paths{$d}->get($k));
	};
      };
    };
    undef $log;
  };

  ## is at least one data set included in the fit?
  my $ok = 0;
  foreach my $d (&all_data) {
    $ok++ if $paths{$d}->get('include');
  };
  ## if not, turn on data0
  unless ($ok) {
    $paths{data0}->make(include=>1);
    toggle_data('data0');
    #foreach my $p (keys %paths) {
    #  next unless ($paths{$p}->get('parent') eq 'data0');
    #  next unless ($paths{$p}->type eq 'feff');
    #  $paths{$p}->make(include=>1);
    #};
  };

  ## display data
  my $first = &first_data;
  $widgets{op_titles} -> delete('1.0', 'end');
  $widgets{op_titles} -> insert('end', $paths{$first}->get('titles'));
  display_page($first);
  $file_menu->menu->entryconfigure($save_index, -state=>'normal'); # data
  $file_menu -> menu -> entryconfigure($save_index+6, -state=>'normal');
  $file_menu -> menu -> entryconfigure($save_index+4, -state=>($Tk::VERSION > 804) ? 'normal' : 'disabled'); # all paths
  (-e $paths{$first}->get('file')) and plot('r', 0);
  $top -> Unbusy unless $is_busy;
  Echo("Read project description \`$file\'.");
  project_state(1);
};




sub read_path {
  my ($r_old_path, $r_args, $r_strings) = @_;
  my $group;
  ## ...................................................................
  ## need to clean up old_path string for projects from before 0.5.009
  ## we can be confident that a project from that era is a single data
  ## set project.  all that should be necessary is appending "data0"
  ## to the old_path string.
  ($$r_old_path = 'data0.' . $$r_old_path) if ($$r_old_path =~ /^feff/);
  ## ...................................................................

  if ($$r_old_path eq 'gsd') {	# --- GSD ---
    $paths{gsd} = Ifeffit::Path -> new(id	    => 'gsd',
				       type	    => 'gsd',
				       from_project => 1,
				       family       => \%paths);
    while (@$r_args) {
      my ($k, $v) = (shift @$r_args, shift @$r_args);
      next if ($k =~ /^(id|type)$/);
      $paths{gsd} -> make($k=>$v);
    };
    foreach my $p (@{$paths{gsd}->{order}}) {
      push @gds, Ifeffit::Parameter->new(name	  => $p,
					 type	  => $paths{gsd}->{$p}->{choice},
					 mathexp  => $paths{gsd}->{$p}->{value},
					 bestfit  => '',
					 error	  => '',
					 modified => 0,
					 note	  => "$p: ");
    };
  } elsif ($$r_old_path =~ /^data\d+$/) { # --- DATA ---
    my $this = $$r_old_path;  ##'data' . $n_data++;
    $paths{$this} = Ifeffit::Path -> new(id	 => $this,
					 group	 => $this,
					 type	 => 'data',
					 sameas	 => 0,
					 from_project => 1,
					 family	 => \%paths);
    $paths{$this.".0"}  = Ifeffit::Path -> new(id	    => $this.".0",
					       type	    => 'fit',
					       from_project => 1,
					       group	    => $this."_fit",
					       sameas       => $this, lab=>'Fit',
					       parent       => 0,
					       family       => \%paths);
    my $saw_include = 0;	# deal with project files pre-0.6.000
    while (@$r_args) {
      my ($k, $v) = (shift @$r_args, shift @$r_args);
      next if ($k =~ /^(id|type|group|sameas|chib)$/); # chib is an old,
                                                       # discarded atribute
      ($saw_include = 1) if ($k eq 'include');
      if ($k eq 'kweight') {	# treat kweight specially for backwards
      SWITCH: {			# compatability for before 0.5.009
	  $paths{$this} -> make(k1=>1), last SWITCH if ($v eq 1);
	  $paths{$this} -> make(k2=>1), last SWITCH if ($v eq 2);
	  $paths{$this} -> make(k3=>1), last SWITCH if ($v eq 3);
	  $paths{$this} -> make(karb_use=>1, karb=>$v);
	};
      } else {
	$paths{$this} -> make($k=>$v);
      };
    };
    $paths{$this} -> make(pcpath=>'None') unless exists $paths{$paths{$this}->get('pcpath')};
    $paths{$this} -> make(include=>1)     unless $saw_include;
    $paths{$this} -> make(lab=>"Data")    unless $paths{$this}->get('lab');

    unless ($this eq 'data0') {
      my $style = ($paths{$this}->get('include')) ? $list_styles{enabled} : $list_styles{disabled};
      $list -> add($this, -text=>$paths{$this}->get('lab'), -style=>$style);

      $list -> add($this.".0", -text=>'Fit', -style=>$style,);
      $list -> setmode($this.'.0', 'close');
      $list -> hide('entry', $this.".0");
    };
    $list -> entryconfigure($paths{$this}->get('id'), -text=>$paths{$this}->get('lab'));
    $list -> setmode($paths{$this}->get('id'), 'close');
    $paths{$this}->make(use_bkg=>0);
    $temp{op_include} = 1;
    $temp{op_plot}    = $paths{$this}->get('plot') || 0;
    ++$n_data;
    my $group = $paths{$this}->get('group');

    if ($paths{$this}->get('file')) {
      ## fixy up path information to accommodate zip-style projects
      my $fl = $paths{$this}->get('file');
      $fl =~ s/\\+/\//g; # convert \ to /
      $paths{$this}->make(file=>$fl);
      my $thisfile = basename($paths{$this}->get('file'));
      $paths{$this} -> make(file=>File::Spec->catfile($project_folder, "chi_data", $thisfile));

      my $file = $paths{$this}->get('file');
      if (-e $file) {
	if (&is_athena_record($file) == 1) {
	  Echo("Reading $file as an Athena record");
	  if ($is_windows) {
	    read_athena_record_on_windows($file, 1, 0);
	  } else {
	    read_athena_record($file, 1, 0);
	  };
	} else {
	  $paths{$this} -> dispose("read_data(file=\"$file\", type=chi, group=$group)\n", 1);
	};
      };
    };
    # solve a problem lingering from early-version project files, this
    # problem will only exist in a single data set project file
    if (lc($paths{data0}->get('pcedge')) =~ /([a-z]{1,2}) (k|l(1|2|3|i{1,3}))/) {
      $paths{data0} -> make(pcelem=>ucfirst($1), pcedge=>ucfirst($2));
    };
    my $titles = "";
    my @all_titles = @$r_strings;
    #($#all_titles = 25) if ($#all_titles > 25);
    map {$titles .= $_."\n"} (@all_titles);
    $paths{$this} -> make(titles=>$titles);
    $fit{count_full} = $paths{$this}->get('count_full');
  } elsif ($$r_old_path =~ /^(data\d+)\.(bkg|diff|fit|res)/) {
    1; ## why is there one of these in the project??
  } elsif ($$r_old_path =~ /feff(\d+)$/) { # --- FEFF CALC ---
    my $this = $$r_old_path;
    ($n_feff < $1) and ($n_feff = $1+1); # bump up feff counter
    $paths{$this} = Ifeffit::Path -> new(id	 => $this,
					 type	 => 'feff',
					 group	 => $this,
					 from_project => 1,
					 family	 => \%paths,);
    while (@$r_args) {
      my ($k, $v) = (shift @$r_args, shift @$r_args);
      next if ($k =~ /^(id|type|group)$/);
      ## the next line addresses a change in the atoms portion of the
      ## feff calc data structure that happened when the atoms page
      ## was redesigned in DR004
      next if ($k =~ /atoms_(elem|tag|occ|x|y|z)/);
      $paths{$this} -> make($k=>$v);
    };
    ## fixy up path information to accommodate zip-style projects
    if ($paths{$this}->get('linkto')) {
      my $l = $paths{$this}->get('linkto');
      $paths{$this} -> make(path=>$paths{$l}->get('path'));
    } else {
      $paths{$this} -> make(path=>File::Spec->catfile($project_folder, $paths{$this}->get('id'), ""));
    };
    my $mode = 0;
    if (-e $paths{$this}->get('atoms.inp')) {
      $mode   += 1;
      &import_atoms($paths{$this}->get('atoms.inp'), 1, $this);
    };
    $paths{$this}->verify_feffinp;
    $mode   += 2 if (-e $paths{$this}->get('feff.inp'));
    $paths{$this} -> make(lab=>'FEFF'.$n_feff) unless ($paths{$this}->get('lab'));
    $paths{$this} -> make(include=>1)          unless (exists $paths{$this}->{include});
    my $parent = $paths{$this}->data;
    my $style = ($paths{$parent}->get('include')) ? $list_styles{noplot} : $list_styles{noplotdis};
    $list -> add($paths{$this}->get('id'), -text=>$paths{$this}->get('lab'), -style=>$style);
    my $intrp_ok = &do_intrp($this);
    $mode   += 4 if $intrp_ok;
    $paths{$this} -> make(mode=>$mode);
    $list -> setmode($paths{$this}->get('id'), 'close');
    ## does this project predate autoparams??
    unless ($paths{$this}->get('autoparams')) {
      my @autoparams;
      $#autoparams = 6;
      (@autoparams = autoparams_define($this, $n_feff, 0, 1)) if $config{autoparams}{do_autoparams};
      $paths{$this} -> make(autoparams=>[@autoparams]);
    };
    $n_feff = $1+1;
    ## feff parents do not have strings
  } elsif ($$r_old_path =~ /((data\d+)\.feff\d+)\.(\d+)/) { # --- PATH ----
    my $this = $$r_old_path;
    my $kid = $list -> addchild($1);
    $paths{$kid} = Ifeffit::Path -> new(id	     => $kid,
					type	     => 'path',
					parent	     => $1,
					data	     => $2,
					from_project => 1,
					intrpline    => "",
					zcwif	     => 0,
					family	     => \%paths);
    while (@$r_args) {
      my ($k, $v) = (shift @$r_args, shift @$r_args);
      next if ($k =~ /^(id|type|group|parent|data)$/);
      $paths{$kid} -> make($k=>$v);
    };
    my $data   = $paths{$kid}->data;
    ($paths{$kid}->make(deg => int $paths{$kid}->get('deg'))) if
      ($paths{$kid}->get('deg') == int $paths{$kid}->get('deg'));
    my $fi = substr($paths{$kid}->get('file'),4,4);
    $paths{$kid} -> make(feff_index=>sprintf('%d', $fi));
    my $save_deg = $paths{$kid}->get('deg');
    my $header = "";
    map {$header .= $_."\n"} (@$r_strings);
    my $file = File::Spec->catfile($paths{$kid}->get('path'), $paths{$kid}->get('feff'));
    ## take care that the file actually exists...
    unless (-e $file) {
      delete $paths{$kid};
      $list -> delete('entry', $kid);
      return;
    };
    $paths{$kid} -> make(header=>nnnn_header($kid, $file),
			 deg=>$save_deg);
    ## plotpath was introduced at DR006
    $paths{$kid} -> make(plotpath=>0) unless $paths{$kid}->get('plotpath');
    $paths{$kid} -> make(is_ss  => 1) if ($paths{$kid}->get("nleg") == 2);
    $paths{$kid} -> make(intrpline => $paths{$kid}->intrpline);
    $paths{$kid}->make(is_col => 1) if ($paths{$kid}->get("intrpline") =~ /\d :/);
    my $style = $list_styles{$paths{$kid}->pathstate};
    $style = ($paths{$paths{$kid}->data}->get('include')) ? $style : $list_styles{disabled};
    $list -> entryconfigure($kid,
 			    -style=> $style,
			    -text => $paths{$kid}->get('lab')
			   );

  };

};




sub delete_project {
  my $restore = $_[0];
  Echo("Closing project ... ");
  my $is_busy = grep (/Busy/, $top->bindtags);
  $top -> Busy unless $is_busy;

  $widgets{athena_return} -> invoke() if ($current_canvas eq 'athena');

  ## get rid of all $artemis_titleN strings
  ifeffit("show \@strings\n");
  my ($lines, @response) = (Ifeffit::get_scalar('&echo_lines')||0, ());
  if ($lines) {
    map {push @response, Ifeffit::get_echo()} (1 .. $lines);
  };
  foreach (@response) {
    $paths{data0} -> dispose("erase $1") if (/^\s*(\$artemis_title\d+)/);
  };

  foreach my $d (&every_data) {
    $paths{$d}->delete_titles;
    unless ($paths{$d}->get('include')) {
      $paths{$d}->make(include=>1);
      &toggle_data($d);
    };
  };
  my $first = first_data;
  $list -> entryconfigure($first, -text=>'Data');
  $list -> setmode($first, 'none');
  $current = $first;
  display_page($first);
  $top->update;
  clear_gds2();
  ## erase data from ifeffit's memory
  foreach my $k (keys %paths) {
    next if ($k eq 'gsd');
    next unless (ref($paths{$k}) =~ /Ifeffit/);
    ## erase fits from tree
    $list -> delete('offsprings', $k) if ($k =~ /^data\d+\.0$/);
    delete_feff($k,1,2) if ($paths{$k}->type eq 'feff');
  };
  $paths{data0} -> dispose("erase \@paths all", $dmode);
  $paths{data0} -> dispose("erase \@arrays", $dmode);
  $paths{data0} -> drop_all;
  $#gds = -1;
  $gds_selected{type}    = "";
  $gds_selected{name}    = "";
  $gds_selected{mathexp} = "";
  $gds_selected{which}   = 0;

  ## reset the extra plotting features
  $extra[0] = 0;
  $extra[1] = 0;
  $extra[2] = 0;
  $extra[3] = 0;
  $extra[4] = 0;
  $extra[5] = "";
  $widgets{plot_extra} -> raise('main');

  foreach my $d (&all_data) {
    foreach ($list->infoChildren($d)) {
      if (/data\d+$/) {	# clear out data
	1;
      } elsif (/feff\d+$/) {	# clear out feff calc
	1; #$list->delete('entry',$_);
      } elsif (/data(\d+)\.\d+/) {	# clear out fit head diff, bkg, res
	$list->delete('entry',$_) unless ($1 == 0);
      };
    };
    clear_op($d);
  };
  $widgets{show_chi} -> invoke();
  map {$widgets{$_} -> configure(-state=>'disabled')} (qw(show_chi show_mu));
  ##--bkg-- clear_athena;
  ##--bkg-- $widgets{data_notebook} -> raise('chi');
  ##--bkg-- $widgets{data_notebook} -> pageconfigure('bkg', -state=>'disabled');
  $list -> hide('entry', "data0.0");

  ## undefine the paths hash, then reset globals
  undef %paths;
  ($n_feff, $n_data) = (0, 0);
  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'disabled')} (keys %widgets);
  $paths{data0} = Ifeffit::Path -> new(id      => 'data0',
				       group   => 'data0',
				       type    => 'data',
				       sameas  => 0,
				       lab     => 'Data',
				       kwindow => $config{data}{kwindow},
				       rwindow => $config{data}{rwindow},
				       family  => \%paths);
  $paths{gsd}   = Ifeffit::Path -> new(id=>'gsd', type=>'gsd', family=>\%paths);
  $list->focus();
  project_state(1);
  $project_name  = "";
  ## disable the save cascades
  map { $file_menu->menu->entryconfigure($_, -state=>'disabled') }
    ($save_index .. $save_index+4, $save_index+6);
  $data_menu->menu->entryconfigure(2, -state=>'disabled');
  $fit_menu ->menu->entryconfigure(4, -state=>'disabled');
  $widgets{op_include} -> configure(-text=>"Include data in the fit?");
  $widgets{op_plot}    -> configure(-text=>"Plot data after the fit?");
  map {$widgets{$_}  -> deselect()} qw(op_do_bkg op_include op_plot); # op_use_bkg
  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'disabled')} (keys %widgets);
  map {$grab{$_}->configure(-state=>'disabled')} (keys %grab);
  ## then clear out the journal ...
  $notes{journal}->delete(qw(1.0 end));
  $widgets{atoms_titles}->delete(qw(1.0 end));
  ## ... and reset the poperties
  $props{'Project title'} = "<insert a title for your project here>";
  $props{'Comment'} = "";
  $props{'Prepared by'} = "<insert your name and/or the name of your computer here>";
  ##$props{'Prepared by'} = ($is_windows) ? "<insert your name and/or the name of your computer here>" :
  ##  join("\@", $ENV{USER}, $ENV{HOST});
  $props{Contact} = "<insert your email address and/or phone number here>";
  $props{Environment} = (split(/\n/, $paths{data0} -> project_header))[1];
  $props{Environment} =~ s/\# /Artemis $VERSION /;
  $props{'Last fit'} = q{};
  $props{'Information content'} = q{};
  $props{'Project location'} = q{};
  $props{Started} = $paths{data0} -> date_of_file;
  ## clean up the GDS page
  &gds2_clear_highlights;
  ## delete autosave file
  unlink $autosave_filename if (-e $autosave_filename);
  Echo("Removed stale autosave file.");

  if ($restore) {
    Echo("Closing project ... done!");
    return;
  };

  # finally, delete the stash directory
  rmtree($project_folder);
  ## $0 does icky, utf8-y things on windows due to the backslashes
  if ($is_windows) {
    $current_data_dir = $ENV{IFEFFIT_DIR};
  } else {
    ($current_data_dir = dirname($0)) if sub_directory($current_data_dir, $project_folder);
  };
  $project_folder = "";
  ## then reset some global variables...
  &set_temp;
  %fit = (index=>1, count=>0, count_full=>0, new=>1, label=>"", comment=>"", fom=>0);
  ## %log_params  ???
  ## and reinitialize the project
  &initialize_project(0);
  my $chdir_to = $current_data_dir || dirname($0) || $ENV{IFEFFIT_DIR};
  $chdir_to = Cwd::abs_path($chdir_to);
  chdir $chdir_to;
  Echo("Closing project ... done!");
  $top -> Unbusy unless $is_busy;
};


sub compactify_project {
  Echo("Compacting project ...");
  $top->Busy;
  foreach my $p (keys %paths) {
    next unless ($paths{$p}->type eq 'feff');
    feff_compactify($p);
  };
  $top->Unbusy;
  Echo("Compacting project ... done!");
  project_state(0);
  &display_properties if ($paths{$current}->type eq 'feff');
  my $message = "All unused files from all Feff calculations have been deleted.  This makes your project file much smaller.\n\nTo recover files that were deleted, simply rerun the Feff calculation and, when it finishes, choose the option to import no paths.";
  &posted_Dialog;
  my $dialog =
    $top -> Dialog(-bitmap         => 'info',
		   -text           => $message,
		   -title          => 'Artemis: Compacting project...',
		   -buttons        => [qw/OK/],
		   -font           => $config{fonts}{med},
		   -default_button => 'OK')
      -> Show();
  Echo(q{});
};


## END OF THE PROJECT FILE SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##



###===================================================================
### record description subsystem
###===================================================================

sub read_record {
  my $file = $_[0];

  open PROJ, $file or die "could not open $file as a project file\n";

  my $cpt = new Safe;
  use vars qw($old_path @args @strings @journal @plot_features @parameter);
  my $from_version = 0;
  while (<PROJ>) {
    if (/^\s*\#\s*Artemis project/) {
      my @list = split(" ",$_);
      $from_version = $list[$#list];
      @list = split(/\./, $from_version);
      $from_version = $#list ? $list[0] . "." . $list[1] . $list[2] : "DR".$list[0];
      $from_version =~ s/rc//;
      next;
    };
    next if (/^\s*\#/);
    next if (/^\s*$/);

  SWITCH: {
      (/^\@parameter/) and do {
	@ {$cpt->varglob('parameter')} = $cpt->reval($_);
	@parameter = @ {$cpt->varglob('parameter')};
	push @gds, Ifeffit::Parameter->new(name	    => $parameter[0],
					   type	    => $parameter[1],
					   mathexp  => $parameter[2],
					   note	    => $parameter[3],
					   autonote => $parameter[4],
					  );
	$gds[$#gds]->make(bestfit  => $parameter[2]) if ($parameter[1] eq 'guess');
	last SWITCH;
      };
      (/^\@journal/) and do {
	## as of 0.7.004 the journal is saved in a file separate from
	## the description file.  so this block is merely to read the
	## journal from the project file from before 0.7.004
	@ {$cpt->varglob('journal')} = $cpt->reval($_);
	@journal = @ {$cpt->varglob('journal')};
	$notes{journal} -> delete(qw(1.0 end));
	foreach (@journal) {
	  $notes{journal} -> insert('end', $_."\n");
	};
	open J, ">".File::Spec->catfile($project_folder, "descriptions", "journal.artemis");
	map { print J $_, $/ } (@journal);
	print J $/;
	close J;
	last SWITCH;
      };
      (/^\%plot_features/) and do {
	% {$cpt->varglob('plot_features')} = $cpt->reval($_);
	while (my ($k, $v) = each % {$cpt->varglob('plot_features')}) {
	  $plot_features{$k} = $v;
	};
	last SWITCH;
      };
      (/^\@extra/) and do {
	@ {$cpt->varglob('extra')} = $cpt->reval($_);
	my @this = @ {$cpt->varglob('extra')};
	@extra[0..6] = @this[0..6];
	foreach (7 .. $#this) {
	  $extra[$_]->[1] = $this[$_]->[0];
	  $extra[$_]->[2] = $this[$_]->[1];
	};
	#{ no warnings;
	#  print join(" ", @extra), $/;};
	last SWITCH;
      };
      (/^\%props/) and do {
	% {$cpt->varglob('props')} = $cpt->reval($_);
	while (my ($k, $v) = each % {$cpt->varglob('props')}) {
	  next if ($k eq 'Environment');
	  next if ($k eq 'Project location');
	  next if ($k eq 'Information content');
	  $props{$k} = $v;
	};
	last SWITCH;
      };
      (/^\$old_path/) and do {
	$ {$cpt->varglob('old_path')} = $cpt->reval($_);
	$old_path = $ {$cpt->varglob('old_path')};
	@args = ();
	@strings = ();
	last SWITCH;
      };
      (/^\@args/) and do {
	@ {$cpt->varglob('args')} = $cpt->reval($_);
	@args = @ {$cpt->varglob('args')};
	last SWITCH;
      };
      (/^\@strings/) and do {
	@ {$cpt->varglob('strings')} = $cpt->reval($_);
	@strings = @ {$cpt->varglob('strings')};
	last SWITCH;
      };
      (/^\[record\]/) and do {
	last SWITCH unless @args;
	&read_path(\$old_path, \@args, \@strings);
	last SWITCH;
      };

    };

  };

  close PROJ;
  return $from_version;
};

sub read_record_on_windows {
  my $file = $_[0];

  open PROJ, $file or die "could not open $file as a project file\n";

  my $cpt = new Safe;
  use vars qw($old_path @args @strings @journal @plot_features @parameter %foo);
  my $from_version = 0;
  while (<PROJ>) {
    if (/^\s*\#\s*Artemis project/) {
      my @list = split(" ",$_);
      $from_version = $list[$#list];
      @list = split(/\./, $from_version);
      $from_version = $#list ? $list[0] . "." . $list[1] . $list[2] : "DR".$list[0];
      $from_version =~ s/rc//;
      next;
    };
    next if (/^\s*\#/);
    next if (/^\s*$/);

  SWITCH: {
      (/^\@parameter/) and do {
	eval $_;
	push @gds, Ifeffit::Parameter->new(name	    => $parameter[0],
					   type	    => $parameter[1],
					   mathexp  => $parameter[2],
					   note	    => $parameter[3],
					   autonote => $parameter[4],
					  );
	$gds[$#gds]->make(bestfit  => $parameter[2]) if ($parameter[1] eq 'guess');
	last SWITCH;
      };
      (/^\@journal/) and do {
	## as of 0.7.004 the journal is saved in a file separate from
	## the description file.  so this block is merely to read the
	## journal from the project file from before 0.7.004
	eval $_;
	$notes{journal} -> delete(qw(1.0 end));
	foreach (@journal) {
	  $notes{journal} -> insert('end', $_."\n");
	};
	open J, ">".File::Spec->catfile($project_folder, "descriptions", "journal.artemis");
	map { print J $_, $/ } (@journal);
	print J $/;
	close J;
	last SWITCH;
      };
      (/^\%plot_features/) and do {
	(my $this = $_) =~ s/^\%plot_features/\%foo/;
	eval $this;
 	foreach my $k (keys %foo) {
 	  $plot_features{$k} = $foo{$k};
 	};
	last SWITCH;
      };
      (/^\@extra/) and do {
	(my $this = $_) =~ s/^\@extra\s+=\s+//;
	my @this = eval $this;
	@extra[0..6] = @this[0..6];
	foreach (7 .. $#this) {
	  $extra[$_]->[1] = $this[$_]->[0];
	  $extra[$_]->[2] = $this[$_]->[1];
	};
	last SWITCH;
      };
      (/^\%props/) and do {
	(my $this = $_) =~ s/^\%props/\%foo/;
	eval $this;
	foreach my $k (keys %foo) {
	  ##next if ($k eq 'Last fit');
	  ($props{$k} = $foo{$k}) unless ($k eq 'Environment');
	};
	last SWITCH;
      };
      (/^\$old_path/) and do {
	eval $_;
	@args = ();
	@strings = ();
	last SWITCH;
      };
      (/^\@args/) and do {
	eval $_;
	last SWITCH;
      };
      (/^\@strings/) and do {
	eval $_;
	last SWITCH;
      };
      (/^\[record\]/) and do {
	last SWITCH unless @args;
	&read_path(\$old_path, \@args, \@strings);
	last SWITCH;
      };

    };

  };

  close PROJ;
  return $from_version;
};


sub read_athena_record {
  my ($file, $from_project, $change) = @_;
  &push_mru($file, 1, "record");
  use vars qw/$old_group @args @x @y @stddev/;
  open F, $file or die "could not open $file as an Athena record\n";
  while (<F>) {
    next if (/^\s*\#/);		# skip blank and commented lines
    next if (/^\s*$/);
    next if (/^\s*1/);
    my $cpt = new Safe;
  SWITCH: {
      (/^\$old_group/) and do {
	$ {$cpt->varglob('old_group')} = $cpt->reval($_);
	$old_group = $ {$cpt->varglob('old_group')};
	last SWITCH;
      };
      (/^\@args/) and do {
	@ {$cpt->varglob('args')} = $cpt->reval($_);
	@args = @ {$cpt->varglob('args')};
	last SWITCH;
      };
      (/^\@x/) and do {
	@ {$cpt->varglob('x')} = $cpt->reval($_);
	@x = @ {$cpt->varglob('x')};
	last SWITCH;
      };
      (/^\@y/) and do {
	@ {$cpt->varglob('y')} = $cpt->reval($_);
	@y = @ {$cpt->varglob('y')};
	last SWITCH;
      };
      (/^\@stddev/) and do {
	@ {$cpt->varglob('stddev')} = $cpt->reval($_);
	@stddev = @ {$cpt->varglob('stddev')};
	last SWITCH;
      };
      ##(/^\$old_group\s*=\s*\'([^\']*)\';$/) and do {
      ##  $old_group = $1;
      ##  last SWITCH;
      ##};
      ((/^\[record\]/) or (/^\&read_record/)) and do {
	#my $memory_ok = &memory_check(0, 1);
	#Echo ("Out of memory in Ifeffit"), last DATA if ($memory_ok == -1);
	last SWITCH;
      };
      1;
    };
  };
  close F;

  ## read the args
  my %args;
  while (@args) {
    my ($key, $val) = (shift @args, shift @args);
    $args{$key} = $val;
  };
  Echo("$file is not an Athena chi(k) record and cannot be imported."),
    return unless $args{is_chi};

  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  $name = (split(/\./, $name))[0];
  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'normal')} (keys %widgets);
  map {$grab{$_}->configure(-state=>'normal')} (keys %grab);

  ## extract the useful parts of @args
  my $group = ($change) ? $paths{$current}->data : 'data'.&next_data;
  my $fit   = $group . '.0';

  ## fill the data arrays
  Ifeffit::put_array("$group.k",   \@x);
  Ifeffit::put_array("$group.chi", \@y);
  ++$n_data;

  if (($change) or (not $current)) {
    $paths{$group} -> make(group  =>$group, file =>$file, lab=>$name,
			   is_rec =>1,);
    $list -> entryconfigure($paths{$group}->get('id'), -text=>$name);
  } else {
    $paths{$group} = Ifeffit::Path -> new(id     => $group,
					  group  => $group,
					  type   => 'data',
					  sameas => 0,
					  file   => $file,
					  lab    => $name,
					  family => \%paths,);
    $list -> add($group, -text=>$name, -style=>$list_styles{enabled});
    $list -> setmode($group, 'none');

    $list -> add($group.".0", -text=>'Fit', -style=>$list_styles{enabled},);
    $list -> setmode($group.'.0', 'close');
    $list -> hide('entry', $group.".0");
  };
  $from_project or
    $paths{$group} -> make(kmin   =>$args{fft_kmin}, kmax   =>$args{fft_kmax},
			   dk     =>$args{fft_dk},   kwindow=>$args{fft_win},
			   rmin   =>$args{bft_rmin}, rmax   =>$args{bft_rmax},
			   dr     =>$args{bft_dr},   rwindow=>$args{bft_win},
			   pcedge =>$args{fft_edge}, pcelem =>$args{bkg_z});
 SWITCH: {
    $paths{$group} -> make(k1=>1), last SWITCH if ($args{fft_kw} eq 1);
    $paths{$group} -> make(k2=>1), last SWITCH if ($args{fft_kw} eq 2);
    $paths{$group} -> make(k3=>1), last SWITCH if ($args{fft_kw} eq 3);
    $paths{$group} -> make(karb_use=>1, karb=>$args{fft_kw});
  };
  $paths{$fit}  = Ifeffit::Path -> new(id     => $group.".0",
				       type   => 'fit',
				       group  => $fit,
				       sameas => $group,
				       parent => 0,
				       family => \%paths);
  my $titles = "";
  map { $titles .= $_ . "\n" } @{$args{titles}};
  $paths{$group} -> make(titles=>$titles);
  ## pc left off by default
  ## $paths{$group} -> make(pcplot=>(lc($args{fft_pc}) eq 'on') ? 'Yes' : 'No');

  ## display data
  display_page($group);
  $file_menu->menu->entryconfigure($save_index, -state=>'normal'); # data
  &plot('r', 0) unless $from_project;
  Echo("Opened record file \`$file\'.");
  project_state(0);

};

sub read_athena_record_on_windows {
  my ($file, $from_project, $change) = @_;
  &push_mru($file, 1, "record");
  use vars qw/$old_group @args @x @y @stddev/;
  open F, $file or die "could not open $file as an Athena record\n";
  while (<F>) {
    next if (/^\s*\#/);		# skip blank and commented lines
    next if (/^\s*$/);
    next if (/^\s*1/);
  SWITCH: {
      (/^\$old_group/) and do {
	$old_group = eval $_;
	last SWITCH;
      };
      (/^\@args/) and do {
	@args = eval $_;
	last SWITCH;
      };
      (/^\@x/) and do {
	@x = eval $_;
	last SWITCH;
      };
      (/^\@y/) and do {
	@y = eval $_;
	last SWITCH;
      };
      (/^\@stddev/) and do {
	@stddev = eval $_;
	last SWITCH;
      };
      ##(/^\$old_group\s*=\s*\'([^\']*)\';$/) and do {
      ##  $old_group = $1;
      ##  last SWITCH;
      ##};
      ((/^\[record\]/) or (/^\&read_record/)) and do {
	#my $memory_ok = &memory_check(0, 1);
	#Echo ("Out of memory in Ifeffit"), last DATA if ($memory_ok == -1);
	last SWITCH;
      };
      1;
    };
  };
  close F;

  ## read the args
  my %args;
  while (@args) {
    my ($key, $val) = (shift @args, shift @args);
    $args{$key} = $val;
  };
  Echo("$file is not an Athena chi(k) record and cannot be imported."),
    return unless $args{is_chi};

  my ($name, $pth, $suffix) = fileparse($file);
  $current_data_dir = $pth;
  $name = (split(/\./, $name))[0];
  map {($_ =~ /^op/) and $widgets{$_}->configure(-state=>'normal')} (keys %widgets);
  map {$grab{$_}->configure(-state=>'normal')} (keys %grab);

  ## extract the useful parts of @args
  my $group = ($change) ? $paths{$current}->data : 'data'.&next_data;
  my $fit   = $group . '.0';

  ## fill the data arrays
  Ifeffit::put_array("$group.k",   \@x);
  Ifeffit::put_array("$group.chi", \@y);
  ++$n_data;

  if (($change) or (not $current)) {
    $paths{$group} -> make(group  =>$group, file =>$file, lab=>$name,
			   is_rec =>1,);
    $list -> entryconfigure($paths{$group}->get('id'), -text=>$name);
  } else {
    $paths{$group} = Ifeffit::Path -> new(id     => $group,
					  group  => $group,
					  type   => 'data',
					  sameas => 0,
					  file   => $file,
					  lab    => $name,
					  family => \%paths,);
    $list -> add($group, -text=>$name, -style=>$list_styles{enabled});
    $list -> setmode($group, 'none');

    $list -> add($group.".0", -text=>'Fit', -style=>$list_styles{enabled},);
    $list -> setmode($group.'.0', 'close');
    $list -> hide('entry', $group.".0");
  };
  $from_project or
    $paths{$group} -> make(kmin   =>$args{fft_kmin}, kmax   =>$args{fft_kmax},
			   dk     =>$args{fft_dk},   kwindow=>$args{fft_win},
			   rmin   =>$args{bft_rmin}, rmax   =>$args{bft_rmax},
			   dr     =>$args{bft_dr},   rwindow=>$args{bft_win},
			   pcedge =>$args{fft_edge}, pcelem =>$args{bkg_z});
 SWITCH: {
    $paths{$group} -> make(k1=>1), last SWITCH if ($args{fft_kw} eq 1);
    $paths{$group} -> make(k2=>1), last SWITCH if ($args{fft_kw} eq 2);
    $paths{$group} -> make(k3=>1), last SWITCH if ($args{fft_kw} eq 3);
    $paths{$group} -> make(karb_use=>1, karb=>$args{fft_kw});
  };
  $paths{$fit}  = Ifeffit::Path -> new(id     => $group.".0",
				       type   => 'fit',
				       group  => $fit,
				       sameas => $group,
				       parent => 0,
				       family => \%paths);
  my $titles = "";
  map { $titles .= $_ . "\n" } @{$args{titles}};
  $paths{$group} -> make(titles=>$titles);
  ## pc left off by default
  ## $paths{$group} -> make(pcplot=>(lc($args{fft_pc}) eq 'on') ? 'Yes' : 'No');

  ## display data
  display_page($group);
  $file_menu->menu->entryconfigure($save_index, -state=>'normal'); # data
  &plot('r', 0) unless $from_project;
  Echo("Opened record file \`$file\'.");
  project_state(0);

};
## -*- cperl -*-
##
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
##  This section of the code contains subroutines associated with
##  ifeffit macros



sub write_macros {
  my $string = "
macro startup
  \"Artemis startup message, used to set character size and font\"
  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 Artemis\")
  erase \@group startup
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

macro eins
  \"Fit Einstein temperature and offset for a MASS1, MASS2 given data in group eins\"
  unguess
  set(eins_hbarc   = 1973.270533,
      eins_boltz   = 8.61738e-5,
      eins_amu2ev  = 9.3149432e8)
  set eins_prefac  = eins_hbarc*eins_hbarc/(2*eins_boltz*eins_amu2ev)
  set eins_rmass   = 1/(1/\$1+1/\$2)
  guess(eins_theta = 300, eins_offset=0.001)
  def eins.vec    = eins_theta/(2*eins.1)
  def eins.thvec  = tanh(eins.vec)
  def eins.y      = eins_prefac/(eins.thvec*eins_rmass*eins_theta) + eins_offset
  def eins.resid  = eins.y-eins.2
  #minimize(eins.resid, uncertainty=eins.3)
  minimize(eins.resid)
  def eins.xx     = indarr(ceil(eins.1) + 50)
  def eins.ovec   = eins_theta/(2*eins.xx)
  def eins.thovec = tanh(eins.ovec)
  def eins.yy     = eins_prefac/(eins.thovec*eins_rmass*eins_theta) + eins_offset
end macro


## end of Artemis' macros
##
##
";
  return $string;
};

## END OF MACROS SUBSECTION
##########################################################################################
## -*- cperl -*-
##
##  This file is part of Artemis, copyright (c) 2002-2008 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, $type) = @_;
  my ($name, $path, $suffix) = fileparse($file);

  return if ($file eq $autosave_filename);
  ## set some global variables
  $current_data_dir = $path;
#  ($project_name = $file) if (&is_record($file));
  return unless ($push_file);

  my $item = $file . ' [' . $type . ']';
  ## 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) {
    ($ifound = $i), last if ($item 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} = $item;

  ## update the mru menu
  &set_recent_menu;

  ## save the mru file
  tied(%mru) -> WriteConfig($mrufile);

  return $name;
};

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};
    if ($config{general}{mru_display} eq "name") {
      $label =~ /^([^\[]*)(\[.*\])/;
      my $type = $2;
      (my $file = $1) =~ s/\s+$//;
      $label = basename($file) . " " . $type;
    };
    $menu -> add('command', -label=>$label, @menu_args,
		   -command=>sub{&dispatch_mru($mru{mru}{$i})});
  };
};


sub dispatch_mru {
  return unless $_[0];
  my ($file, $type) = ($_[0], "");
  ($file, $type) = ($1, $2) if ($_[0] =~ /(.+) \[(\w+)\]$/);
  Echo("Could not find \"$file\""), return unless (-e $file);
  Echo("Reading recent file \"$file\"");
  if ($type eq 'atoms') {
    &import_atoms($file);
  } elsif ($type eq 'feff') {
    &read_feff($file);
  } elsif ($type eq 'feffit') {
    &feffit_convert_input($file);
  } elsif ($type eq 'project') {
    &read_data($paths{$current}->data, $file);
  } elsif ($type eq 'athena') {
    &read_athena($file);
  } else {			# data
    my @data = &every_data;
    my $this = $paths{$current}->data;
    if ($#data or $paths{$this}->get('file')) {
      my $message = "Do you wish to read in a new data file (that is, to do multiple data set fitting), or do you wish to change the current data file (that is, to apply this fitting model to a different data set) ?";
      my $dialog =
	$top -> Dialog(-bitmap         => 'questhead',
		       -text           => $message,
		       -title          => 'Athena: Reading data',
		       -buttons        => [qw/Change New Cancel/],
		       -default_button => 'Change',
		       -font           => $config{fonts}{med},
		       -popover        => 'cursor');
      &posted_Dialog;
      my $response = $dialog->Show();
      Echo("Canceling data import"), return if ($response eq 'Cancel');
      Echo("Reading \"$file\"");
      my $change = ($response eq 'Change') ? 1 : 0;
      read_data($change, $file);
    } else {
      read_data(0, $file);
    };
    ##&dispatch_read_data(1, $file);
  };
  ## make sure something is marked for plotting after the fit
  my @all = &all_data;
  foreach (@all) {
      return $type if $paths{$_}->get('plot');
  };
  $widgets{op_plot} -> select;
  $paths{$all[0]}->make(plot=>1);
  return $type;
};


## END OF MRU SUBSECTION
##########################################################################################
# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##

###===================================================================
### preferences subsystem
###===================================================================

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;



  map {$_ -> configure(-state=>'disabled')}
    ($gsd_menu, $feff_menu, $paths_menu, $data_menu, $sum_menu, $fit_menu); #, $settings_menu);
  $edit_menu -> menu -> entryconfigure(13, -state=>'disabled');
 SWITCH: {
    $opparams  -> packForget(), last SWITCH if ($current_canvas eq 'op');
    $gsd       -> packForget(), last SWITCH if ($current_canvas eq 'gsd');
    $feff      -> packForget(), last SWITCH if ($current_canvas eq 'feff');
    $path      -> packForget(), last SWITCH if ($current_canvas eq 'path');
    $logviewer -> packForget(), last SWITCH if ($current_canvas eq 'logview');
  };
  $current_canvas = 'prefs';

  my $prefs = $fat -> Frame(-relief=>'flat',
			    -borderwidth=>0,
			    -highlightcolor=>$config{colors}{background})
    -> pack(-expand=>1, -fill=>'both');


  $prefs_params{save} = 0;
  $prefs -> Label(-text	       => "Edit Preferences",
		  @title2,
		  -background  => $config{colors}{background2},
		  -borderwidth => 2,
		  -relief      => 'groove',
		  -anchor      => 'center')
    -> pack(-side=>'top', -anchor=>'w', -padx=>0, -fill=>'x');


  my $labframe = $prefs -> LabFrame(-label=>'All parameters',
				    -labelside=>'acrosstop')
    -> pack(-side=>'left', -expand=>1, -fill=>'both');
  my $tree;
  $tree = $labframe -> Scrolled('Tree', -scrollbars=>'se', -width=>15,
				-background=>'white',
				-browsecmd=>sub{&browse_variable($tree, \%prefs_params)},
				  )
    -> pack(-expand=>1, -fill=>'both');
  $tree->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
  $tree->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});

  $prefs -> Button(-text=>'Return to the main window',  @button3_list,
		   #-background=>$config{colors}{background},
		   #-activebackground=>$config{colors}{activebackground},
		   -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          => 'Artemis: preferences...',
					-buttons        => [qw/Yes No/],
					-default_button => 'Yes',
					-font           => $config{fonts}{med},
					-popover        => 'cursor');
		       &posted_Dialog;
		       $response = $dialog->Show();
		     }
		     if ($response eq 'Yes') {
		       &prefs_apply(\%prefs_params);
		       &prefs_save(\%prefs_params);
		     };
		     Echo("Your preferences were applied and saved to $personal_rcfile")
		       if ($response eq 'Yes');
		     $prefs->packForget;
		     $current_canvas = "";
		     $edit_menu -> menu -> entryconfigure(13, -state=>'normal');
		     &display_properties;
		     Echo("Restored normal view") unless ($response eq 'Yes');
		   })
    -> pack(-side=>'bottom', -fill=>'x');
  $prefs_params{future} = $prefs -> Button(-text=>'Save changes for future sessions',  @button2_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');
  $prefs_params{apply} = $prefs -> Button(-text=>'Apply changes to this session',  @button2_list,
					  -state=>'disabled',
					  -command=>sub{
					    &prefs_apply(\%prefs_params);
					    $prefs_params{apply} ->configure(-state=>'disabled');
					  } )
    -> pack(-side=>'bottom', -fill=>'x');
  ## need a restore all values button


  my $frame = $prefs -> Frame(-relief=>'flat')
    -> pack(-side=>'right');#, -fill=>'both');

  my $subfr = $frame -> Frame()
    -> pack(-side=>'top');
  $prefs_params{parameter_label} = $subfr -> Label(-text=>'Parameter:  ',
						   -justify=>'right',
						   -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>0, -column=>0, -sticky=>'e');
  $prefs_params{parameter} = $subfr -> Label(-text=>'', -justify=>'left')
    -> grid(-row=>0, -column=>1, -sticky=>'ew');
  $subfr -> Label(-text=>'Type:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>1, -column=>0, -sticky=>'e');
  $prefs_params{type} = $subfr -> Label(-text=>'', -width=>15, -justify=>'left')
    -> grid(-row=>1, -column=>1, -sticky=>'ew');
  $subfr -> Label(-text=>"Artemis' Default:  ",
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>2, -column=>0, -sticky=>'e');
  $prefs_params{default} = $subfr -> Label(-text=>'', -justify=>'left')
    -> grid(-row=>2, -column=>1, -sticky=>'ew');
  $subfr -> Label(-text=>'Value:  ',
		  -justify=>'right',
		  -foreground=>$config{colors}{activehighlightcolor})
    -> grid(-row=>3, -column=>0, -sticky=>'e');
  $prefs_params{values} = $subfr -> Label(-text=>'', -justify=>'left')
    -> grid(-row=>3, -column=>1, -sticky=>'ew');


  $frame -> Button(-text=>"Set ALL parameters to Artemis' defaults",  @button2_list,
		   -command=>[\&prefs_restore_all, \%prefs_params, $tree])
    -> pack(-side=>'bottom', -expand=>1, -fill=>'x', -padx=>4, -pady=>4);

  $labframe = $frame -> LabFrame(-label=>'Description', -labelside=>'acrosstop')
    -> pack(-side=>'top', -expand=>1, -fill=>'both');
  $prefs_params{description} = $labframe -> Scrolled('ROText', -scrollbars=>'oe',
						     -wrap=>'word',
						     #-width=>35, -height=>15
						    )
    -> pack(-expand=>1, -fill=>'both');
  $prefs_params{description}->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
  &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}}) {
    ##next if (($s eq 'Histogram') and ($use_histo));
    $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();

  ##Echo("Showing preferences dialog");
  $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, -sticky=>'ew');
    $$rhash{values} -> gridForget();
    $$rhash{values} = $frame -> Label(-text=>'',)
      -> grid(-row=>3, -column=>1, -sticky=>'ew');
    return;
  };

  $$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;
					};
					$$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, -sticky=>'ew');

  my ($small, $med) = ($config{fonts}{small}, $config{fonts}{med});
  $$rhash{default}   -> configure(-font=>($$rhash{$s}{$v}{type} eq 'folder') ?
				  $small : $med);
  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});
  };
  if ($$rhash{$s}{$v}{type} eq 'folder') {
    my $text = $$rhash{default} -> cget('-text');
    ($text = substr($text, 0, 7) . "..." . substr($text, -7)) if (length($text) > 15);
    $$rhash{default} -> configure(-text=>$text);
  };

  #$$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') or ($$rhash{$s}{$v}{type} eq 'font')) {
    my $rcfile = $setup -> find('artemis', 'rc_personal');
    $$rhash{description} -> insert('end', "\n\nFonts cannot currently be changed interactively.  You will need to edit $rcfile by hand.", 'warn');
  ##} elsif (($s eq 'gds') and ($$rhash{$s}{$v}{type} eq 'color')) {
  ##  $$rhash{description} -> insert('end', "\n\nColor changes on the parameters page will take effect the next time you start Artemis.", '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 if the match_as parameter is set to \"perl\".", 'warn');
  };

  $$rhash{description} -> insert('end', "\n\nColor changes do not currently take effect until the next time Artemis is started.  That will eventually be fixed.", 'descr')
    if ($s eq 'colors');

  if (($s eq 'general') and ($v eq 'workspace')) {
    $$rhash{description} -> insert('end', "\n\nThe current project will be deleted when you change this parameter.  If you want to change this parameter, you should first return to the main menu and save your current project.\n", 'warn');
    $$rhash{description} -> insert('end', "\n\nThe fully resolved path is currently\n$$rhash{$s}{$v}{new}", 'descr');
  };
  $$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 Artemis 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 Artemis' default value for this variable.", 'descr');

  $$rhash{values} -> gridForget();
 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, -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, -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 'folder') and do {
      my $text = $$rhash{$s}{$v}{new};
      ($text = substr($text, 0, 7) . "..." . substr($text, -7)) if (length($text) > 15);
      $$rhash{values} = $frame -> Button(-foreground=>'black',
					 -borderwidth=>1,
					 -text=>$text,
					 -font=>$config{fonts}{small},
					 -command=>
					 sub{
					   my $dir;
					   if ($Tk::VERSION < 804) {
					     $top -> Dialog(-bitmap  => 'error',
							    -text    => "Changing folders using this dialog requires perl/Tk 804.  You are using perl/Tk $Tk::VERSION.",
							    -title   => 'Artemis: Unable to change folders',
							    -buttons => ['OK'],
							    -font           => $config{fonts}{med},
							    -default_button => "OK", )
					       -> Show();
					     return;
					   #  $dir = $top -> DirSelect(-width=>40, -dir=>$$rhash{$s}{$v}{new},
						#		      -title=> "Artemis: Select a directory",
						#		      -text => "Select the path to your workspace",
						#		     ) -> Show;
					   } else {
					     $dir = $top -> chooseDirectory;
					   };
					   return unless ($dir and (-d $dir));
					   $$rhash{$s}{$v}{new}=$dir;
					   ($dir = substr($dir, 0, 7) . "..." . substr($dir, -7)) if (length($dir) > 15);
					   $$rhash{values}->configure(-text=>$dir);
					   $$rhash{save} = 1;
					   $$rhash{apply} ->configure(-state=>'normal');
					   $$rhash{future}->configure(-state=>'normal');
					 })
	-> grid(-row=>3, -column=>1, -sticky=>'ew');
      last SWITCH;
    };

    ($$rhash{$s}{$v}{type} eq 'file') and do {
      my $text = $$rhash{$s}{$v}{new};
      ($text = substr($text, 0, 7) . "..." . substr($text, -7)) if (length($text) > 15);
      $$rhash{values} = $frame -> Button(-foreground=>'black',
					 -borderwidth=>1,
					 -text=>$text,
					 -font=>$config{fonts}{small},
					 -command=>
					 sub {
					   my $path = $current_data_dir || cwd;
					   my $types = [['Executables', '*.exe'], ['All files', '*'],];
					   my $file = $top ->
					     getOpenFile(-filetypes  => $types,
							 ##(not $is_windows) ?
							 ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
							 -multiple   => 0,
							 -initialdir =>$path,
							 -title      => "Artemis: Select Feff executable");
					   return unless ($file and (-e $file));
					   $$rhash{$s}{$v}{new}=$file;
					   ($file = substr($file, 0, 7) . "..." . substr($file, -7)) if (length($file) > 15);
					   $$rhash{values}->configure(-text=>$file);
					   $$rhash{save} = 1;
					   $$rhash{apply} ->configure(-state=>'normal');
					   $$rhash{future}->configure(-state=>'normal');
					 })
	-> grid(-row=>3, -column=>1, -sticky=>'ew');
    };

    ($$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, -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},
					  )
	-> grid(-row=>3, -column=>1, -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 '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},
					   -maxvalue=>$$rhash{$s}{$v}{maxint},
					  )
	-> grid(-row=>3, -column=>1, -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}{med},
					     -borderwidth=>1,
					     -textvariable=>\$$rhash{$s}{$v}{new}
					     )
	-> grid(-row=>3, -column=>1, -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 'atp') and do {
      my $atpdir = $paths{data0} -> find('atoms', 'atp_personal');
      opendir A, $atpdir;
      my @use = ();

      my @personal = grep {/atp$/} readdir A;
      closedir A;
      @personal = map {s/\.atp$//; $_} @personal;
      foreach (@personal) {
	local $/ = undef;
	my $this = $_ . ".atp";
	next unless open F, File::Spec->catfile($atpdir, $this);
	my $snarf = <F>;
	close F;
	push @use, $_ if ($snarf =~ /meta.*:feff/);
      };

      opendir S, $Xray::Atoms::atp_dir;
      my @system = grep {/atp$/} readdir S;
      closedir S;
      @system = map {s/\.atp$//; $_} @system;
      foreach (@system) {
	local $/ = undef;
	my $this = $_ . ".atp";
	next unless open F, File::Spec->catfile($Xray::Atoms::atp_dir, $this);
	my $snarf = <F>;
	close F;
	push @use, $_ if ($snarf =~ /meta.*:feff/);
      };

      ## see Perl Cookbook, recipe 4.6;
      my %seen = ();
      foreach my $item (@use) {
	$seen{$item}++;
      };
      my @vals = sort(keys %seen);

      $$rhash{values} = $frame -> Optionmenu(-font=>$config{fonts}{med},
					     -borderwidth=>1,
					     -textvariable=>\$$rhash{$s}{$v}{new}
					     )
	-> grid(-row=>3, -column=>1, -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}{check},
					      -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, -sticky=>'ew');
      last SWITCH;
    };
    ($$rhash{$s}{$v}{type} eq 'color') and do {
      my $color = $$rhash{$s}{$v}{new} || 'black';
      my ($r, $g, $b) = $frame -> rgb($color);
      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");
      $$rhash{values} = $frame -> Button(-background=>$color,
					 -activebackground=>$acolor,
					 -borderwidth=>1,
					 -command=>sub{
					   my $color = "";
					   #$top->Busy();
					   $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, -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 ".$setup -> find('artemis', 'rc_personal')." by hand.")})
	-> grid(-row=>3, -column=>1, -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;
};

## 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 Artemis?  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          => 'Artemis: preferences...',
		   -buttons        => [qw/Yes No/],
		   -default_button => 'Yes',
		   -font           => $config{fonts}{med},
		   -popover        => 'cursor');
  &posted_Dialog;
  my $response = $dialog->Show();
  unless ($response eq 'Yes') {
    Echo("Not restoring defaults for preferences.");
    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 %old = (charsize    => $config{plot}{charsize},
	     charfont    => $config{plot}{charfont},
	     workspace   => $config{general}{workspace},
	     logstyle    => $config{log}{style},
	     layout      => $config{general}{layout},
	     mru_display => $config{general}{mru_display},
	    );

  my $rhash = $_[0];
  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

  ## sanity checks for cormin, rmin, rmax, others
  ($config{data}{cormin} = 0) if ($config{data}{cormin} < 0);
  ($config{data}{cormin} = 1) if ($config{data}{cormin} > 1);
  (($config{data}{rmin}, $config{data}{rmax}) = ($config{data}{rmax}, $config{data}{rmin}))
    if ($config{data}{rmin} > $config{data}{rmax});
  ($config{warnings}{reff_margin} = 1) if ($config{warnings}{reff_margin} <= 0);

  ## set default analysis parameter values
  $setup -> SetDefault(fit_space => $config{data}{fit_space},
		       do_bkg    => ($config{data}{fit_bkg}) ? 'yes' : 'no',
		       kmin      => $config{data}{kmin},
		       kmax      => $config{data}{kmax},
		       dk        => $config{data}{dk},
		       k1        => ($config{data}{kweight} == 1),
		       k2        => ($config{data}{kweight} == 2),
		       k3        => ($config{data}{kweight} == 3),
		       rmin      => $config{data}{rmin},
		       rmax      => $config{data}{rmax},
		       dr        => $config{data}{dr},
		       kwindow   => $config{data}{kwindow},
		       rwindow   => $config{data}{rwindow},
		       cormin    => $config{data}{cormin},
		      );

  foreach my $k (qw(window_multiplier bg fg grid showgrid
		    c0 c1 c2 c3 c4 c5 c6 c7 c8 c9
		    datastyle fitstyle partsstyle
		    key_x key_y key_dy
		   )) {
    $plot_features{$k} = $config{plot}{$k};
  };
  $plot_features{rmax_out} = $config{data}{rmax_out};
  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});

  #$log_params{prefer} = $config{logview}{prefer};

  unless ($config{general}{layout} eq $old{layout}) {
    map {$_->packForget} ($fat, $skinny, $skinny2);
    &layout;
  };
  &set_recent_menu if ($old{mru_display} ne $config{general}{mru_display});

  ## 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)
  } elsif ($config{general}{projectbar} eq 'title') {
    $project_label -> configure(-textvariable=>\$props{'Project title'});
    $projectbar -> pack(-side=>"top", -anchor=>'nw', -fill=>'x'); #, -after=>$menubar)
  };
  ## handle general.workspace parameter
  ##($config{general}{workspace} =~ s/\~/$ENV{HOME}/) unless ($is_windows);
  ##$stash_dir = $config{general}{workspace};
  ##&delete_project unless (same_directory($old{workspace}, $config{general}{workspace}));

  ## default log style
  @log_type = set_log_style($config{log}{style}) unless ($old{logstyle} eq $config{log}{style});

  $paths{data0} -> dispose("plot(charsize=$config{plot}{charsize}, charfont=$config{plot}{charfont})", $dmode)
    if (($old{charsize} != $config{plot}{charsize}) or ($old{charfont} != $config{plot}{charfont}));

  $file_menu -> menu -> entryconfigure(5, -state=>($config{general}{import_feffit}) ? 'normal' : 'disabled');

  ## manage_geometry($config{geometry}{main_width}, $config{geometry}{main_height});
  &manage_extended_params;
  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 manage_geometry {
  my ($w, $h) = @_;
#  $skinny2 -> packPropagate(0);
  $fat -> packPropagate(1);
  $fat -> pack(-expand => 1);
  $fat -> configure(-width  => $w.'c', -height => $h.'c',);
  $top -> update;
  $fat -> pack(-expand => 0);
  $fat -> packPropagate(0);
#  $skinny2 -> packPropagate(1);

  my @geom = split(/[+x]/, $top->geometry);
  print join(" ", @geom), $/;
  my $extrabit = ($Tk::VERSION < 804) ? 30 : 0;
  ($extrabit = 0) if ($is_windows);
  $top -> minsize($geom[0], $geom[1]+$extrabit);
};


sub read_config {
  my $rhash = $_[0];
  my $config_file = $paths{data0} -> find('artemis', '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/^ *\./\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 '""');
	$line[1] =~ s/ENV___(\w*)___/$ENV{$1}/ if $is_windows;
	$$rhash{$current_section}{$current_variable}{windows} = $line[1];
	last SWITCH;
      };
      ## max value for integer or 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 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("Read master configuration file $config_file");

};

## END OF THE PREFERENCES SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##

###===================================================================
### log file subsystem
###===================================================================


sub log_file_display {
  my $which = $_[0] || 'results';
  $which = 'results' unless (($which eq 'results') or ($which eq 'files'));
  my $is_busy = grep (/Busy/, $top->bindtags);
  $top -> Busy unless $is_busy;

  $notes{$which} -> delete('1.0', 'end');
  my $log = $_[1] || File::Spec->catfile($project_folder, "fits",
					 sprintf("fit%4.4d", $fit{count}), "log");
  ##print join("!", @_), $/;
  ##print join("|", $log, @log_type), $/;
  Echo("Could not read log file \"$log\""), return unless (-e $log);
 SWITCH:{

    ## raw log file
    ($log_type[1] eq 'raw') and do {
      open F, $log;
      while (<F>) {
	$_ =~ s{\r}{} if not $is_windows;
	if ($_ =~ /^!!/) {
	  $notes{$which} -> insert('end', $_, 'warning');
	} elsif ($_ =~ /\.\.$/) {
	  $notes{$which} -> insert('end', $_, 'pathid');
	} else {
	  $notes{$which} -> insert('end', $_);
	};
      }
      $notes{$which} -> yviewMoveto(0);
      close F;
      last SWITCH;
    };

    ## quick view
    ($log_type[1] eq 'quick') and do {
      my $data = Ifeffit::ArtemisLog -> new($log);
      my $was_sum = grep {/Fitting was not performed./} ($data->get('warnings'));
      ## header
      $notes{$which} -> insert('end', "Project title   : " . $data -> get('Project title') . "\n");
      $notes{$which} -> insert('end', "Comment         : " . $data -> get('Comment') . "\n");
      $notes{$which} -> insert('end', "Figure of merit : " . $data -> get('Figure of merit') . "\n");
      ## statistics
      $notes{$which} -> insert('end', $data->stats) unless $was_sum;
      ## guesses
      $notes{$which} -> insert('end', $data->guess);
      ## restraints
      $notes{$which} -> insert('end', $data->restraint);
      ## afters
      $notes{$which} -> insert('end', $data->after);
      undef $data;
      last SWITCH;
    };

    ## columnar view
    ($log_type[1] eq 'column') and do {
      my $data = Ifeffit::ArtemisLog -> new($log);
        #print Data::Dumper->Dump([$data], [qw(*data)]);
        #$top -> Unbusy unless $is_busy;
        #return;
      my $was_sum = grep {/Fitting was not performed./} ($data->get('warnings'));
      $notes{$which} -> insert('end', $data->header);
      $notes{$which} -> insert('end', $data->stats) unless $was_sum;
      $notes{$which} -> insert('end', $data->guess);
      if ($data->list('def')) {
	my $wsp = &which_set_path;
	($wsp)?
	  $notes{$which} -> insert('end', $data->def($paths{$wsp}->descriptor())) :
	    $notes{$which} -> insert('end', $data->def);
      };
      $notes{$which} -> insert('end', $data->restraint) if $data->list('restraint');
      $notes{$which} -> insert('end', $data->set) if $data->list('set');
      $notes{$which} -> insert('end', $data->after) if $data->list('after');
      $notes{$which} -> insert('end', $data->correlations) unless $was_sum;
      ## restraints  data_header  columns
      foreach my $d ($data->list('data')) {
	my $l = 0;
	foreach my $p ($data->get($d, 'paths')) {
	  ($l = length($p)) if (length($p) > $l);
	};
	my $spacer = " " x $l;
	$l+=3;
	my $labels = "    path" . $spacer . "degen     amp      sigma^2    e0        reff     delta_R    R\n";
	$notes{$which} -> insert('end', $data->dataparams($d,0));
	## tables of path param values
	$notes{$which} -> insert('end', $labels);
	$notes{$which} -> insert('end', "  " . "-" x length($labels) . "--\n");
	my $pattern = '  %-' . $l . join(" ", qw(s %9.5f %9.3f %9.5f %9.5f %9.5f %9.5f %9.5f %s));
	foreach my $p ($data->get($d, 'paths')) {
	  $notes{$which} -> insert('end', sprintf($pattern,
						   "\"".$p."\"",
						   $data->get($d, $p, 'degen'),
						   $data->get($d, $p, 's02'),
						   $data->get($d, $p, 'ss2'),
						   $data->get($d, $p, 'e0'),
						   $data->get($d, $p, 'r')-$data->get($d, $p, 'dr'),
						   $data->get($d, $p, 'dr'),
						   $data->get($d, $p, 'r'),
						   "\n"
						  ));
	};
	$notes{$which} -> insert('end', "\n");
	my $write_second_table = 0;
	my $epsilon = 0.000001;
	foreach my $p ($data->get($d, 'paths')) {
	  foreach my $param (qw(ei 3rd 4th dphase)) {
	    ++$write_second_table if (abs($data->get($d, $p, $param)) > $epsilon);
	  };
	};
	if ($write_second_table) {
	  $pattern = '  %-' . $l . join(" ", qw(s %9.5f %9.5f %9.5f %9.5f %s));
	  $labels = "    path" . $spacer . "ei        3rd       4th      dphase\n";
	  $notes{$which} -> insert('end', $labels);
	  $notes{$which} -> insert('end', "  " . "-" x length($labels) . "--\n");
	  foreach my $p ($data->get($d, 'paths')) {
	    $notes{$which} -> insert('end', sprintf($pattern,
						    "\"".$p."\"",
						    $data->get($d, $p, 'ei'),
						    $data->get($d, $p, '3rd'),
						    $data->get($d, $p, '4th'),
						    $data->get($d, $p, 'dphase'),
						    "\n"
						   ));
	  };
	};
	$notes{$which} -> insert('end', "\n");
	$notes{$which} -> insert('end', "\n");
      };
      last SWITCH;
    };
    ## operational view
    ($log_type[1] eq 'operational') and do {
      my $data = Ifeffit::ArtemisLog -> new($log);
      ## header
      $notes{$which} -> insert('end', $data->header);
      my $was_sum = grep {/Fitting was not performed./} ($data->get('warnings'));
      $notes{$which} -> insert('end', $data->stats) unless $was_sum;
      foreach my $d ($data->list('data')) {
	$notes{$which} -> insert('end', $data->dataparams($d,0));
      }
      last SWITCH;
    };
  };
  $top -> Unbusy unless $is_busy;
};

sub set_log_style {
  return ('Raw log file', 'raw')    if ($_[0] eq 'raw');
  return ('Quick view',   'quick')  if ($_[0] eq 'quick');
  return ('Column view',  'column') if ($_[0] eq 'column');
};


## END OF THE LOG SUBSYSTEM

# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2006 Bruce Ravel
##

###===================================================================
### log viewer subsystem
###===================================================================

sub logviewer {

  #Echo("You can only look at the log viewer when the data, feff, path or gsd views are showing"),
  #  return unless ($current_canvas =~ /(feff|gsd|path|op)/);
  %log_params = (param	     => 'Statistical parameters',
		 absorber    => '',
		 scatterer   => '',
		 is_einstein => 0,
		 average     => 0,
		 force	     => 0,
		 zero        => 0,
		 prefer      => $config{logview}{prefer});

  my $logview = $_[0] -> Frame(-relief=>'flat',
			       #@window_size,
			       -borderwidth=>0,
			       -highlightcolor=>$config{colors}{background});

  my $fr = $logview -> Frame(-background  => $config{colors}{background2},
			  -borderwidth => 2,
			  -relief      => 'groove',
			 )
    -> pack(-padx=>0, -pady=>0, -fill=>'x');
  $fr -> Label(-text=>"Examine log files", @title2, -background  => $config{colors}{background2},)
    -> pack(-side=>'left', -anchor=>'w', -padx=>6);
##   $widgets{log_latest} = $fr -> Label(-text=>'',
## 				      -font=>$config{fonts}{bold},
## 				      -foreground=>$config{colors}{foreground},
## 				      -background  => $config{colors}{background2})
##     -> pack(-side=>'right', -anchor=>'w', -padx=>6);
  $widgets{log_current} = $fr -> Label(-text=>'',
				       -font=>$config{fonts}{bold},
				       -foreground=>$config{colors}{foreground},
				       -background  => $config{colors}{background2},)
    -> pack(-side=>'right', -anchor=>'w', -padx=>6);
   $fr -> Label(-text=>'Current fit:',
		-font=>$config{fonts}{bold},
		-foreground=>$config{colors}{button},
		-background  => $config{colors}{background2},)
    -> pack(-side=>'right', -anchor=>'w', -padx=>0);
  $fr -> Label(-text=>'Displaying:',
	       -font=>$config{fonts}{bold},
	       -foreground=>$config{colors}{button});
  ##  -> pack(-side=>'right', -anchor=>'w', -padx=>0);

  my $lfr = $logview -> LabFrame(-label=>'Fits', -labelside=>'acrosstop',
				 -width=>14)
    -> pack(-side=>'left', -fill=>'y');

  $widgets{loglistbox} = $lfr -> Scrolled('HList',
					  -scrollbars	    => 'osoe',
					  -background	    => 'white',
					  -selectmode	    => 'extended',
					  -selectbackground => $config{colors}{selected},
					  -cursor           => $mouse_over_cursor,
					  -command	    =>
					  sub{
					    #&display_file('', $widgets{loglistbox}->infoData($widgets{loglistbox}->infoSelection))
					    logview_show($config{log}{style});
					  },
			     )
    -> pack(-side=>'top', -expand=>1, -fill=>'both');
  $widgets{loglistbox}->Subwidget("xscrollbar")->configure(-background=>$config{colors}{background});
  $widgets{loglistbox}->Subwidget("yscrollbar")->configure(-background=>$config{colors}{background});
  $widgets{loglistbox}->bind('<ButtonPress-3>',\&logview_post_menu);
  BindMouseWheel($widgets{loglistbox});

  $widgets{log_select} = $lfr -> Button(-text=>'Select all',
					@button2_list,)
    -> pack(-side=>'top', -fill=>'x');
  $lfr -> Button(-text=>'Clear selection',
		 @button2_list,
		 -command=>sub{$widgets{loglistbox}->selectionClear();
			       $widgets{loglistbox}->anchorClear();})
    -> pack(-side=>'top', -fill=>'x');


  my $right = $logview -> Frame()
    -> pack(-side=>'right', -fill=>'both', -expand=>1);

  $lfr = $right -> LabFrame(-label=>'Choose a parameter', -labelside=>'acrosstop',)
    -> pack(-side=>'top', -fill=>'x');
  $widgets{log_param_list} = $lfr -> BrowseEntry(-font=>$config{fonts}{med},
						 (($is_windows) ? () :
						  (-disabledforeground => $config{colors}{foreground},
						   -state => 'readonly')),
						 -width=>25,
						 -variable=>\$log_params{param},
						 -browsecmd=>\&logview_write_report,
						)
    -> pack(-padx=>1, -pady=>1, -fill=>'x');
  $lfr -> Button(-text=>'Get parameters from Guess, Def, Set list',
		 @button2_list,
		 -command=>sub{&logview_param_list('gds')})
    -> pack(-padx=>1, -pady=>1, -fill=>'x');

  $widgets{log_write} = $right ->
    Button(-text=>'Parameter report',  @button2_list,
	   -command=>\&logview_write_report )
    -> pack(-side=>'top', -fill=>'x', -pady=>2, -padx=>3);

  $lfr = $right -> LabFrame(-label=>'Calculations', -labelside=>'acrosstop',)
    -> pack(-side=>'top', -fill=>'x', -pady=>3);
  $widgets{log_av} =
    $lfr -> Checkbutton(-text=>'Compute the average value',
			-selectcolor=>$config{colors}{check},
			-foreground=>$config{colors}{activehighlightcolor},
			-activeforeground=>$config{colors}{activehighlightcolor},
			-variable=>\$log_params{average},
			-onvalue=>1, -offvalue=>0, -anchor=>'w',
			-command=>sub{
			  if ($log_params{einstein}) {
			    $widgets{log_ei} -> deselect;
			    $widgets{log_al} -> configure(-foreground => ($log_params{einstein}) ?
							  $config{colors}{activehighlightcolor} :
							  $config{colors}{disabledforeground});
			    $widgets{log_sl} -> configure(-foreground => ($log_params{einstein}) ?
							  $config{colors}{activehighlightcolor} :
							  $config{colors}{disabledforeground});
			    $widgets{log_ae} -> configure(-state => ($log_params{einstein}) ?
							  'normal' : 'disabled');
			    $widgets{log_se} -> configure(-state => ($log_params{einstein}) ?
							  'normal' : 'disabled');
			  };
			})
    -> pack(-padx=>1, -pady=>1, -fill=>'x');
  $widgets{log_ei} =
    $lfr -> Checkbutton(-text=>'Fit Einstein temp. to sigma^2 values',
			-selectcolor=>$config{colors}{check},
			-foreground=>$config{colors}{activehighlightcolor},
			-activeforeground=>$config{colors}{activehighlightcolor},
			-variable=>\$log_params{einstein},
			-onvalue=>1, -offvalue=>0, -anchor=>'w',
			-command=>sub{
			  $widgets{log_av} -> deselect if $log_params{average};
			  $widgets{log_al} -> configure(-foreground => ($log_params{einstein}) ?
							$config{colors}{activehighlightcolor} :
							$config{colors}{disabledforeground});
			  $widgets{log_sl} -> configure(-foreground => ($log_params{einstein}) ?
							$config{colors}{activehighlightcolor} :
							$config{colors}{disabledforeground});
			  $widgets{log_ae} -> configure(-state => ($log_params{einstein}) ?
							'normal' : 'disabled');
			  $widgets{log_se} -> configure(-state => ($log_params{einstein}) ?
							'normal' : 'disabled');
			})
      -> pack(-padx=>1, -pady=>1, -fill=>'x');
  $fr = $lfr -> Frame()
    -> pack(-padx=>1, -pady=>1, -fill=>'x');
  $widgets{log_al} = $fr -> Label(-text=>'Absorber: ', -foreground=>$config{colors}{disabledforeground})
    -> pack(-side=>'left', -expand=>1);
  $widgets{log_ae} = $fr -> Entry(-width=>3, -textvariable=>\$log_params{absorber}, -state=>'disabled')
    -> pack(-side=>'left', -expand=>1);
  $widgets{log_sl} = $fr -> Label(-text=>'Scatterer: ', -foreground=>$config{colors}{disabledforeground})
    -> pack(-side=>'left', -expand=>1);
  $widgets{log_se} = $fr -> Entry(-width=>3, -textvariable=>\$log_params{scatterer}, -state=>'disabled')
    -> pack(-side=>'left', -expand=>1);

  $lfr -> Frame(-borderwidth=>2, -relief=>'sunken', -height=>2)
    -> pack(-side=>'top', -pady=>4, -padx=>8, -fill=>'x');

  $widgets{log_rfactor} = $lfr -> Radiobutton(-text	        => "Prefer R-factor",
					      -variable	        => \$log_params{prefer},
					      -value	        => 'rfactor',
					      -selectcolor      => $config{colors}{check},
					      -foreground       => $config{colors}{activehighlightcolor},
					      -activeforeground => $config{colors}{activehighlightcolor},
					      -state            => 'disabled',
					      -command          => sub{$log_params{param} = 'Statistical parameters';
								       &logview_write_report;
								       &logview_plot},
					     )
    -> pack(-side=>'top', -expand=>1, -anchor=>'w');
  $widgets{log_chinu} = $lfr -> Radiobutton(-text	      => "Prefer reduced chi-square",
					    -variable	      => \$log_params{prefer},
					    -value	      => 'chinu',
					    -selectcolor      => $config{colors}{check},
					    -foreground       => $config{colors}{activehighlightcolor},
					    -activeforeground => $config{colors}{activehighlightcolor},
					    -state            => 'disabled',
					    -command          => sub{$log_params{param} = 'Statistical parameters';
								     &logview_write_report;
								     &logview_plot},
					   )
    -> pack(-side=>'top', -expand=>1, -anchor=>'w');

  $lfr -> Frame(-borderwidth=>2, -relief=>'sunken', -height=>2)
    -> pack(-side=>'top', -pady=>4, -padx=>8, -fill=>'x');

  $widgets{log_zero} = $lfr -> Checkbutton(-text	     => "Show y=0 in plot",
					   -variable	     => \$log_params{zero},
					   -onvalue          =>1,
					   -offvalue         =>0,
					   -anchor           =>'w',
					   -selectcolor      => $config{colors}{check},
					   -foreground       => $config{colors}{activehighlightcolor},
					   -activeforeground => $config{colors}{activehighlightcolor},
					   -command          => sub{&logview_write_report;
								    &logview_plot},
					   )
    -> pack(-side=>'top', -expand=>1, -anchor=>'w');

  ##$widgets{log_plot}  = $right ->
  ##  Button(-text=>'Plot report',  @button2_list, -state=>'disabled',
  ##	   -command=>\&logview_plot )
  ##    -> pack(-side=>'top', -fill=>'x', -pady=>2);
  ##$fr = $right -> Frame()
  ##  -> pack(-side=>'top', -fill=>'x', -pady=>2);

  $widgets{log_summaries} = $right ->
    Button(-text=>'Quick summaries of selected fits', @button2_list,
	   -command=>\&logview_quick_summary )
    -> pack(-side=>'top', -fill=>'x', -pady=>12, -padx=>3);



  $widgets{help_logview} =
    $right -> Button(-text=>'Document: Log viewer',  @button2_list,
		     -command=>sub{pod_display("artemis_logview.pod")} )
      -> pack(-side=>'bottom', -fill=>'x', -pady=>2);


  return $logview;
};



sub populate_logview {
  ## --- fill the HList with fit labels
  opendir F, File::Spec->catfile($project_folder, "fits");
  my @fits = sort( grep {/fit\d+/ and -d  File::Spec->catfile($project_folder, "fits", $_)} readdir(F) );
  closedir F;
  $widgets{loglistbox} -> delete('all');
  my @which;
  my $count = 0;
  foreach my $f (@fits) {
    local $| = 1;
    next unless -e File::Spec->catfile($project_folder, "fits", $f, 'label');
    open LL, File::Spec->catfile($project_folder, "fits", $f, 'label');
    my $label = <LL>;
    close LL;
    push(@which, $count) if ($f eq $fits[0]);
    push(@which, $count) if ($f eq $fits[-1]);
    my $add = 1;
    foreach my $p (keys %paths) {
      next unless ($paths{$p}->type eq 'fit');
      next unless  $paths{$p}->get('parent');
      next unless ($paths{$p}->get('folder') eq $f);
      $add = 0 if  $list -> info('hidden',$p);
      $add = 1 if ($list->getmode($paths{$p}->get('parent')) eq 'open');
      last;
    };
    ## don't add if this one is hidden
    if ($add) {
      $widgets{loglistbox}
	-> add($count,
	       -itemtype => 'text',
	       -text     => $label,
	       -data     => File::Spec->catfile($project_folder, "fits", $f, "log"));
      ++$count;
    };
  };
  ## --- set the callback on the "select all" button
  $widgets{log_select} -> configure(-command=>sub{$widgets{loglistbox}->selectionSet(@which)});
  ## --- fill the list of parameters
  logview_param_list('gds');
  ## --- disable write button if there are no unhidden fits
  $widgets{log_write}     -> configure(-state=>($count) ? 'normal' : 'disabled');
  $widgets{log_summaries} -> configure(-state=>($count) ? 'normal' : 'disabled');
  ## --- disable the plot button
  ##$widgets{log_plot}  -> configure(-state=>'disabled');
  $log_params{force} = 0;
};



sub logview_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);

  ## need to know how many fits there are...
  opendir F, File::Spec->catfile($project_folder, "fits");
  my @fits = sort( grep {/fit\d+/ and -d  File::Spec->catfile($project_folder, "fits", $_)} readdir(F) );
  closedir F;

  ## post the message with parameter-appropriate text
  my $which = $w->selectionGet();
  $which    = (ref($which) eq 'ARRAY') ? $$which[0] : $which;
  my $label = $widgets{loglistbox}->entrycget($entry, '-text');
  my ($X, $Y) = ($Ev->X, $Ev->Y);
  $top ->
    Menu(-tearoff=>0,
	 -menuitems=>[[ command=>"Show raw log file for \"$label\"",
		       -command=>[\&logview_show, 'raw']
		      ],
		      [ command=>"Show column view of log file for \"$label\"",
		       -command=>[\&logview_show, 'column']
		      ],
		      [ command=>"Show quick view of log file for \"$label\"",
		       -command=>[\&logview_show, 'quick']
		      ],
		      [ command=>"Show operational view of log file for \"$label\"",
		       -command=>[\&logview_show, 'operational']
		      ],
		      "-",
		      [ command=>"Get parameter list from \"$label\"",
		       -command=>sub{logview_param_list('file', $widgets{loglistbox}->infoData($widgets{loglistbox}->infoSelection))}
		      ],
		      "-",
		      [ command=>"Restore the \"$label\" fit model",
		       -command=>sub{logview_restore_model($which)},
		       -state=>($#fits) ? 'normal' : 'disabled']
		     ])
      -> Post($X, $Y);
  $w -> break;


};

sub logview_show {
  my @save = @log_type;
 SW: {
    @log_type = ('Raw log file', 'raw'),               last SW if ($_[0] eq 'raw');
    @log_type = ('Column file',  'column'),            last SW if ($_[0] eq 'column');
    @log_type = ('Quick view',   'quick'),             last SW if ($_[0] eq 'quick');
    @log_type = ('Operational view',   'operational'), last SW if ($_[0] eq 'operational');
    @log_type = ('Raw log file', 'raw');
  };
  $current_file = $widgets{loglistbox}->infoData($widgets{loglistbox}->infoSelection);
  log_file_display('files', $current_file);
  Echo("Showed $log_type[0] for $current_file");
  @log_type = @save;
  raise_palette('files');
};


sub logview_param_list {
  my ($how, $file) = @_;
  my @vars;
  if ($how eq 'gds') {
    ## names of all non-skip parameters
    @vars = map  { $_->name } (grep {$_->type !~ /s(e|ki)p/} @gds);
  } else {
    return unless (-e $file);
    my $data = Ifeffit::ArtemisLog -> new($file);
    push @vars, sort($data -> list('guess')), sort($data -> list('def')),
      sort($data -> list('set'));
  };
  unshift @vars, "Statistical parameters"; #, "Data parameters";
  #'Chi-square', 'Reduced Chi-square', 'R-factor';
  $widgets{log_param_list} -> delete(0,'end');
  my $seen = 0;
  foreach my $v (@vars) {
    $widgets{log_param_list} -> insert('end', $v);
    $seen = 1 if (lc($log_params{param}) eq lc($v));
  };
  ($log_params{param} = 'Statistical parameters') unless $seen;
  Echo("Loaded parameter list from GDS page"), return if ($how eq 'gds');
  Echo("Loaded parameter list from the log file for ".$widgets{loglistbox}->selectionGet);
};


sub logview_write_report {
  my $listbox = $widgets{loglistbox};
  #my $rhash   = $_[1];
  $log_params{is_einstein} = 0;
  my @list;
  my @logs;
  $widgets{log_select}->invoke unless ($listbox->selectionGet);
  foreach my $l ($listbox->selectionGet) {
    push @list, $l;
    push @logs, Ifeffit::ArtemisLog->new($listbox->infoData($l));
  };
  Error("You have not selected any log files"), return unless @list;
  ## set param name so that Ifeffit::ArtemisLog will recognize it
  my $param   = $log_params{param};
  #($param = 'chisqr') if ($param eq 'Chi-square');
  #($param = 'chinu')  if ($param eq 'Reduced Chi-square');
  #($param = 'rfact')  if ($param eq 'R-factor');
  (($log_params{average}, $log_params{einstein}) = (0,0)) if ($param eq 'Statistical parameters');
  (($log_params{average}, $log_params{einstein}) = (0,0)) if ($param eq 'Data parameters');
  ## compute average and standard deviation of best fits values, if requested
  my ($sum, $sdv) = (0, 0);
  if (($log_params{average}) and ($#logs>=1)) {
    map { $sum += ($_ -> get($param))[0] } @logs;
    $sum /= ($#logs+1);
    map { $sdv += ( ($_ -> get($param))[0] - $sum )**2 } @logs;
    $sdv /= $#logs;
  };
  ## do einstein fit if requested
  my ($thetae, $dth, $offset, $doff) = (0,0,0,0);
  if ($log_params{einstein}) {
    ($thetae, $dth, $offset, $doff) =
      &logview_do_einstein(\@logs, $param);# pass the data
  };
  ## write report
  my $message = "# $props{'Project title'}\n";
  $message   .= "# report on \"$log_params{param}\"\n";
  ($message  .= sprintf("# the average value of $log_params{param} is %.5f +/- %.5f\n", $sum, sqrt($sdv)))
    if ($log_params{average} and ($#logs>=1));
  ## deal with the einstein fit
  $log_params{absorber}  ||= " ";
  $log_params{scatterer} ||= " ";
 EINS: {
    ($log_params{einstein} and ($thetae>0)) and do {
      $message  .= sprintf("# these data fit an Einstein temperature of %8.3f +/- %.3f\n", $thetae, $dth);
      $message  .= sprintf("# with an offset of %.6f +/- %.6f\n", $offset, $doff);
      $log_params{is_einstein} = 1;
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-1)) and do {
      $message  .= "# The Einstein fit could not be done because\n# Xray::Absorption is not installed\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-2)) and do {
      $message  .= "# The Einstein fit could not be done because\n# \`$log_params{absorber}\' is not an element symbol\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-3)) and do {
      $message  .= "# The Einstein fit could not be done because\n# \`$log_params{scatterer}\' is not an element symbol\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-4)) and do {
      $message  .= "# The Einstein fit could not be done because\n# there are fewer than three data points\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-5)) and do {
      $message  .= "# The Einstein fit could not be done because\n# the data arrays were of unequal length\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-6)) and do {
      $message  .= "# The Einstein fit could not be done because\n# the temperature array does not seem to contain temperature data\n";
      last EINS;
    };
    ($log_params{einstein} and ($thetae==-7)) and do {
      $message  .= "# The Einstein fit could not be done because\n# the sigma^2 array does not seem to contain sigma^2 data\n";
      last EINS;
    };
  };

  $message   .= "# -----------------------------------------------------------------\n";

  if ($param eq 'Statistical parameters') {
    $message   .= "#  fit            FoM    R-factor   Reduced_chi-square  Chi-square   nvar   nidp\n";
    foreach my $i (0..$#list) {
      $message .= sprintf("  %-15s  %-6s  %6.4f  %11.3f        %11.3f    %3d    %3d\n",
			  "'".$listbox->itemCget($list[$i], 0, '-text')."'",
			  $logs[$i]->get('Figure of merit'),
			  $logs[$i]->get('rfact'),
			  $logs[$i]->get('chinu'),
			  $logs[$i]->get('chisqr'),
			  $logs[$i]->get('nvar'),
			  $logs[$i]->get('nidp'),
			 );
    };
##   } elsif ($param eq 'Data parameters') {
##     my $n_set = 0;
##     foreach my $d ($data->list('data')) {
##       ++$n_set;
##       $message   .= "\n\n Data set $n_set\n\n";
##       $message   .= "#  fit            kw   k-range    dk   R-range  dR\n";
##       foreach my $i (0..$#list) {
## 	$message .= sprintf("  %-15s  %-7s [%6.4f:%6.4f]  %4.2  [%6.4f:%6.4f]  %4.2\n",
## 			    "'".$listbox->itemCget($list[$i], 0, '-text')."'",
## 			    $logs[$i]->get($d, 'kw'),
## 			    $logs[$i]->get($d, 'kmin'),
## 			    $logs[$i]->get($d, 'kmax'),
## 			    $logs[$i]->get($d, 'dk'),
## 			    $logs[$i]->get($d, 'rmin'),
## 			    $logs[$i]->get($d, 'rmax'),
## 			    $logs[$i]->get($d, 'dr'),
## 			   );
##       };
##     };
  } else {
    $message   .= "#  fit            FoM            $log_params{param}";
    $message   .= (grep {/^$param$/} $logs[0]->list('guess')) ? "               +/-             initial\n" : "\n";
    foreach my $i (0..$#list) {
      my ($first, $pat) = ($list[$i], '%-20s');
      ## need to report error bars for guess values
      my $val = (grep {/^$param$/} $logs[$i]->list('guess')) ? '%15.7f  %15.7f      %s' : '%15.7f';
      my @ll = $logs[$i]->get($param);
      #($ll[0] = (split(/=/, $ll[0]))[0]) if (grep {/^$param$/} $logs[$i]->list('after'));
      next if (($ll[0] == -999) or ($ll[0] == -998)); # skip if unused in the fit

      ## here, one could try to evaluate a math expression if a param
      ## is guessed as a mathexp.  in stead, I'll just print the mathexp.
      $message .= sprintf("  %-15s  %-6s  $val\n",
			  "'".$listbox->itemCget($list[$i], 0, '-text')."'",
			  $logs[$i]->get('Figure of merit'), @ll);

      ## need to take care about a param guessed as another param (note
      ## this will plotz for deeply nested guessing-as-param
      #($ll[2] = ($logs[$i]->get($ll[2]))[2]) unless (not exists($ll[2]) or ($ll[2] =~ /-?\d*\.\d+/));
    };
  };
  &post_message($message, "report");
  if ($#logs) {
    ##$widgets{log_plot}    -> configure(-state=>'normal');
    $widgets{log_rfactor} -> configure(-state=>'disabled');
    $widgets{log_chinu}   -> configure(-state=>'disabled');
    if ($log_params{param} =~ /Statistical/) {
      $widgets{log_rfactor} -> configure(-state=>'normal');
      $widgets{log_chinu}   -> configure(-state=>'normal');
    };
  };
  my $plot_return = &logview_plot unless ($log_params{param} eq 'Data parameters');
  $top -> update();
  Echo("Wrote and plotted report on \"$log_params{param}\"") unless $plot_return;
};

## return (theta, d_theta, offset, d_offset)
## error codes, theta=
##   -1   Xray::Absorption not installed
##   -2   Absorber symbol is not an element
##   -3   Scatterer symbol is not an element
##   -4   Not enough data points
##   -5   Arrays of unequal length (probably unable to harvest temperatures)
##   -6   temperature array does not appear to be valid data
##   -7   sigma^2 array does not appear to be valid data
sub logview_do_einstein {
  my $rlogs = $_[0];
  my $param = $_[1];
  #return (-1,0,0,0) unless $absorption_exists;
  $log_params{absorber}  =~ s/\s+//g;
  return (-2,0,0,0) unless Xray::Absorption->in_resource($log_params{absorber});
  $log_params{scatterer} =~ s/\s+//g;
  return (-3,0,0,0) unless Xray::Absorption->in_resource($log_params{scatterer});
  my $abs = Xray::Absorption->get_atomic_weight($log_params{absorber});
  my $sca = Xray::Absorption->get_atomic_weight($log_params{scatterer});
  my (@t, @ss, @err);
  foreach my $l (@$rlogs) {
    push @t,    $l -> get('Figure of merit');
    push @ss,  ($l -> get($param))[0];
    push @err, ($l -> get($param))[1] || 0;
  };
  return (-4,0,0,0) unless ($#t >= 2);
  return (-5,0,0,0) unless (($#t == $#ss) and ($#t == $#err));
  my ($t_bad, $ss_bad) = (0,0);
  map { ++$t_bad  if (($_ < 0) or ($_ > $config{logview}{eins_temp_max})) } @t;
  return (-6,0,0,0) if $t_bad;
  map { ++$ss_bad if ($_ > $config{logview}{eins_sigma_max}) } @ss;
  return (-7,0,0,0) if $ss_bad;
  Ifeffit::put_array('eins.1', \@t);
  Ifeffit::put_array('eins.2', \@ss);
  Ifeffit::put_array('eins.3', \@err);
  ##$paths{gsd} -> dispose("show \@group eins", $dmode);
  $paths{gsd} -> dispose("eins $abs $sca", $dmode);
  my ($th, $dth, $off, $doff) =  (Ifeffit::get_scalar('eins_theta'),
				  Ifeffit::get_scalar('delta_eins_theta'),
				  Ifeffit::get_scalar('eins_offset'),
				  Ifeffit::get_scalar('delta_eins_offset') );
  $paths{gsd} -> dispose("unguess", $dmode);
  return ($th, $dth, $off, $doff);
};



sub logview_plot {
  Echo("Cannot plot data parameters"), return if ($log_params{param} eq 'Data parameters');
  my $param   = $log_params{param};
  if ($log_params{is_einstein}) {
    $paths{gsd} -> dispose("set ___min = floor(eins.2)",1);
    my $ym = Ifeffit::get_scalar("___min");
    $ym = ($ym < 0) ? 1.1*$ym : 0;
    my $message = "eins.1, eins.2, dy=eins.3, ymin=$ym, xmin=0, title=\"Einstein fit\", ";
    $message   .= "xlabel=\"temperature (K)\", ylabel=\"\\gs\\u2\\d (\\A\\u-2\\d)\", ";
    $message   .= "key=data, style=points16, color=$config{plot}{c0}";
    $message   .= ", ymin=0" if $log_params{zero};
    $message    = wrap("newplot(", "        ", $message) . ")\n";
    $message   .= "plot(eins.xx, eins.yy, style=lines, key=fit, color=$config{plot}{c1})";
    $paths{gsd} -> dispose($message, $dmode);
  } else {
    ## set param name so that Ifeffit::ArtemisLog will recognize it
    ##     my $param   = $log_params{param};
    ##     ($param = 'chisqr') if ($param eq 'Chi-square');
    ##     ($param = 'chinu')  if ($param eq 'Reduced Chi-square');
    ##     ($param = 'rfact')  if ($param eq 'R-factor');
    my (@x, @val, @err, @fth);
    foreach my $l (split(/\n/, $notes{messages} -> get(qw(1.0 end)))) {
      next if ($l =~ /^\s*\#/);
      next if ($l =~ /^\s*$/);
      $l = substr($l, index($l, "'")+1);
      $l = substr($l, index($l, "'")+1);
      my @line = split(" ", $l);
      push @x,   $line[0];
      push @val, $line[1];
      push @err, $line[2] || 0;
      push @fth, $line[3] || 0;
    };
    Error("Plot aborted.  You only selected one fit."), return 1 unless $#x;
    if ($log_params{param} =~ /Statistical/) {
      Ifeffit::put_array("l___og.1", \@x);
      if ($log_params{prefer} eq 'rfactor') {
	$param = "R-factor";
	Ifeffit::put_array("l___og.2", \@val);
      } elsif ($log_params{prefer} eq 'chinu') {
	$param = "reduced chi-square";
	Ifeffit::put_array("l___og.2", \@err);
      } else {
	$param = "chi-square";
	Ifeffit::put_array("l___og.2", \@fth);
      };
      my $message = "l___og.1, l___og.2, title=\"Report on $param\", ";
      $message   .= "xlabel=\"Figure of merit\", ylabel=\"$param\", ";
      $message   .= "key=$param, style=points3, markersize=4, color=$config{plot}{c0}";
      $message   .= ", ymin=0" if $log_params{zero};
      $message    = wrap("newplot(", "        ", $message) . ")\n";
      $paths{gsd} -> dispose($message, $dmode);
    } else {
      Ifeffit::put_array("l___og.1", \@x);
      Ifeffit::put_array("l___og.2", \@val);
      Ifeffit::put_array("l___og.3", \@err);
      my $message = "l___og.1, l___og.2, dy=l___og.3, title=\"Report on $param\", ";
      $message   .= "xlabel=\"Figure of merit\", ylabel=\"$param\", ";
      $message   .= "key=$param, style=points16, color=$config{plot}{c0}";
      $message   .= ", ymin=0" if $log_params{zero};
      $message    = wrap("newplot(", "        ", $message) . ")\n";
      $paths{gsd} -> dispose($message, $dmode);
    };
    #$paths{gsd} -> dispose("plot(style=line)\n", $dmode);
  };
  Echo("Plotted $param");
  return 0;
};


sub logview_quick_summary {
  $widgets{log_select}->invoke unless ($widgets{loglistbox}->selectionGet);
  $notes{messages} -> delete(qw(1.0 end));
  foreach my $l ($widgets{loglistbox}->selectionGet) {
    my $data = Ifeffit::ArtemisLog->new($widgets{loglistbox}->infoData($l));
    my $was_sum = grep {/Fitting was not performed./} ($data->get('warnings'));
    ## header
    $notes{messages} -> insert('end', "Project title   : " . $data -> get('Project title') . "\n");
    $notes{messages} -> insert('end', "Comment         : " . $data -> get('Comment') . "\n");
    $notes{messages} -> insert('end', "Figure of merit : " . $data -> get('Figure of merit') . "\n");
    ## statistics
    $notes{messages} -> insert('end', $data->stats) unless $was_sum;
    ## guesses
    $notes{messages} -> insert('end', $data->guess);
    ## restraints
    $notes{messages} -> insert('end', $data->restraint);
    ## separator
    $notes{messages} -> insert('end', $/ . "=*=" x 20 . $/ x 2);
    undef $data;
  };
  $notes{messages} -> yviewMoveto(0);
  $top -> update;
  raise_palette('messages') unless $_[2];
};


## show the latest fit if this is the head of a branch
sub logview_show_fom {
  my $data = $paths{$current}->data;
  my $which = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');
  Echo("The figure of merit for \"" . $paths{$which}->descriptor .
       "\" is " . $paths{$which}->get('value'))
}

sub logview_change_fom {
  logview_change_fit_property("fom");
};
sub logview_change_comment {
  logview_change_fit_property("comment");
};
sub logview_change_fit_property {

  ## before doing this, shift anchor from head of fit branch to latest
  my $data = $paths{$current}->data;
  my $which = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');
  $list->anchorSet($which);
  &display_properties;
  $top -> update;

  ## set some variables based on what's being changed
  my ($long, $lclong, $old) = (q{}, q{}, q{});
 SW: {
    ($_[0] eq 'fom') and do {
      $long = "Figure of merit";
      $lclong = lc($long);
      $old = $paths{$current}->get('value');
      last SW;
    };
    ($_[0] eq 'comment') and do {
      $long = "Comment";
      $lclong = lc($long);
      last SW;
    };
  };

  my $new = $old;
  my $label = "$long for \"" . $paths{$current}->short_descriptor . "\": ";
  my $dialog = get_string($dmode, $label, \$new);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Not changing the $lclong for \"".$paths{$current}->short_descriptor."\""),
    return if ($new eq $old);
  my @parts = split(/\./, $current);
  foreach my $d (&every_data) {
    my $key = "$d.0.$parts[2]";
    next unless $list->info('exists', $key);
    $paths{$key}->make(value=>$new);
  };

  ## need to make the change permanent by altering the log file
  my $folder = $paths{$current}->get('folder');
  my $log = File::Spec->catfile($project_folder, 'fits', $folder, 'log');
  do {
    local $/ = undef;
    local $| = 1;
    open L, $log;
    my $contents = <L>;
    close L;
    $contents =~ s/($long\s*:).*\n/$1  $new\n/;
    open L, ">".$log;
    print L $contents;
    close L;
  };

  project_state(0);
  Echo("Changed $lclong for \"" .
       $paths{$current}->descriptor .
       "\" to \'$new\'");
};

## show the latest fit if this is the head of a branch
sub logview_show_comment {
  my $data = $paths{$current}->data;
  my $which = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');

  my $log = $_[1] || File::Spec->catfile($project_folder,
					 "fits",
					 $paths{$which}->get('folder'),
					 "log"
					);
  my $logfile = Ifeffit::ArtemisLog -> new($log);

  Echo("Comment for \""
       . $paths{$which}->descriptor
       . "\" :   "
       . $logfile->get('Comment')
      )
}


### some subs for managing the fit branches in the Data and Paths List

sub rename_fit {

  ## before doing this, shift anchor from head of fit branch to latest
  if (($paths{$current}->type eq 'fit') and
      (not $paths{$current}->get('parent')) and
      ($paths{$current}->get('thisfit'))) { # this keeps it from
				            # plotzing when writing a
                                            # script without actually
                                            # running
    display_page($paths{$current}->get('thisfit'));
  };
  $top -> update;

  my $old = $paths{$current}->get('lab');
  my $new = $old;
  my $label = "Rename \"" . $paths{$current}->short_descriptor . "\" to: ";
  my $dialog = get_string($dmode, $label, \$new, \@rename_buffer);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Echo("Not changing the name of \"".$paths{$current}->short_descriptor."\""),
    return if ($new eq $old);
  $new =~ s{[\"\']}{}g;
  project_state(0);
  push @rename_buffer, $new;
  my @parts = split(/\./, $current);
  foreach my $d (&every_data) {
    my $key = "$d.0.$parts[2]";
    next unless $list->info('exists', $key);
    $paths{$key}->make(lab=>$new);
    $list -> itemConfigure($key, 0, -text=>$new);
  };
  Echo("Renamed for \'$old\' to \'$new\'");
  ## --- touch the label file
  my $file = File::Spec->catfile($project_folder, "fits", $paths{$current}->get('folder'), "label");
  open L, ">".$file;
  print L $new;
  close L;
  populate_logview if ($current_canvas eq 'logview');
};


sub hide_fit {

  ## before doing this, shift anchor from head of fit branch to latest
  if (($paths{$current}->type eq 'fit') and
      (not $paths{$current}->get('parent')) and
      ($paths{$current}->get('thisfit'))) { # this keeps it from
				            # plotzing when writing a
                                            # script without actually
                                            # running
    &display_page($paths{$current}->get('thisfit'));
  };
  $top -> update;

  ## need to hide this fit in other data sets as well.
  my @parts = split(/\./, $current);
  Echo("Hiding ".$paths{$current}->get('lab'));
  foreach my $d (&every_data) {
    my $key = "$d.0.$parts[2]";
    next unless $list->info('exists', $key);
    $list -> selectionClear($key);
    $list -> hide('entry', $key);
    $list -> itemConfigure($d.".0", 0, -style=>$list_styles{hidden});
  };
  &keyboard_up;
  &populate_logview;
};

sub hide_selected_fits {
  my $anchor = $list->info('anchor') || 'data0';
  foreach my $p ($list->info('selection')) {
    next unless (($paths{$p}->type eq 'fit') and $paths{$p}->get('parent'));
    my @parts = split(/\./, $p);
    foreach my $d (&every_data) {
      my $key = "$d.0.$parts[2]";
      next unless $list->info('exists', $key);
      $list -> selectionClear($key);
      $list -> hide('entry', $key);
      $list -> itemConfigure($d.".0", 0, -style=>$list_styles{hidden});
    };
  };
  if (($paths{$anchor}->type eq 'fit') and $paths{$anchor}->get('parent')) {
    my $pa = $paths{$anchor}->get('parent');
    &display_page($pa);
  };
  Echo("Hid selected fits.");
};

sub show_fits {
  foreach my $p (keys %paths) {
    next unless (($paths{$p}->type eq 'fit') and $paths{$p}->get('parent'));
    next unless ($list->info('hidden', $p));
    $list -> show('entry', $p);
    $list -> itemConfigure($paths{$p}->get('parent'), 0, -style=>$list_styles{enabled});
  };
  my $anchor = $list->info('anchor') || 'data0';
  &populate_logview if ($paths{$anchor}->type eq 'fit');
  Echo("Showing all fits.");
};


sub discard_fit {
  my $solo = $_[0];
  my $which = $_[0] || $current;

  unless ($solo) {
    ## before doing this, shift anchor from head of fit branch to latest
    if (($paths{$which}->type eq 'fit') and
	(not $paths{$which}->get('parent')) and
	($paths{$which}->get('thisfit'))) { # this keeps it from
				            # plotzing when writing a
                                            # script without actually
                                            # running
      &display_page($paths{$which}->get('thisfit'));
    };
    $top -> update;
    $which = $current;
  };

  ## this could have already been deleted if this is called as part of
  ## delete selected or delete all
  return unless exists $paths{$which};
  ##Echo($paths{$which}->descriptor . " is not a fit."),
  return unless (($paths{$which}->type eq 'fit') and $paths{$which}->get('parent'));

  ## need to get some info while the object still exists ...
  my $this_count = (split(/\./, $which))[2];
  my $folder = File::Spec->catfile($project_folder,
				   "fits",
				   $paths{$which}->get('folder'));
  my $above = $list->info('prev', $which);
  my $was = $paths{$which}->descriptor;

  foreach my $d (&every_data) {
    my $this = $d . ".0." . $this_count;
    ## repoint thisfit in the head fit object if it pointed at this one
    next unless exists $paths{$this};
    my $parent = $paths{$this}->parent;
    if ($paths{$parent}->get('thisfit') eq $this) {
      my $prev = $list->info('prev', $this);
      if (($paths{$prev}->type eq 'fit') and $paths{$prev}->get('parent')) {
	$paths{$parent}->make(thisfit=>$prev);
      } else {
	$paths{$parent}->make(thisfit=>0);
      };
    };

    ## erase these data from Ifeffit
    my $group = $paths{$this}->get('group');
    $paths{$this}->dispose("erase \@group $group\n", $dmode);

    ## undef the object
    delete $paths{$this};

    ## remove the DPL entry
    $list->delete('entry', $this);
  };

  ## delete the fit folder
  rmtree($folder,0,0) if -d $folder;

  ## reset fit_count if it was the latest
  if ($fit{count} == $this_count+1) {
    --$fit{count};
    foreach my $d (&every_data) {
      ## what about Sum?
      if (not exists $fit{recent}) {
	$list -> entryconfigure($d.".0", -text=>"Fit");
      } elsif ($fit{recent} eq 'fit') {
	$list -> entryconfigure($d.".0", -text=>"Fit");
      } else {
	$list -> entryconfigure($d.".0", -text=>"Sum");
      };
      ##$list -> entryconfigure($d.".0", -text=>"Fit [$fit{count}]");
    };
  };

  return if $solo;
  ## and finally, redisplay the newly anchored list entry
  &display_page($above);
  project_state(0);
  Echo("Discarded \"$was\".");
};


sub discard_selected_fits {
  my $data = $paths{$current}->data;
  foreach my $f ($list->info('selection')) {
    next unless (($paths{$f}->type eq 'fit') and $paths{$f}->get('parent'));
    discard_fit($f);
  };
  &display_page($data);
  project_state(0);
  Echo("Discarded selected fits.");
};

sub discard_all_fits {
  my $data = $paths{$current}->data;
  my @list = sort(keys %paths);
  foreach my $f (@list) {
    next unless exists $paths{$f};
    next unless (($paths{$f}->type eq 'fit') and $paths{$f}->get('parent'));
    discard_fit($f);
  };
  foreach my $d (&every_data) {
    ## what about Sum?
    $list -> entryconfigure($d.".0", -text=>"Fit");
  };
  #$fit{new} = 1;
  #$fit{count} = 0;
  #$fit{count_full} = 0;
  %fit = (index=>1, count=>0, count_full=>0, new=>1, label=>"", comment=>"", fom=>0);
  &display_page($data);
  project_state(0);
  Echo("Discarded all fits.");
};


sub save_fit {
  my ($suff, $space) = @_;
  my $kind = "Fit";
  ($kind = "Residual")   if ($suff eq 'res');
  ($kind = "Background") if ($suff eq 'bkg');
  my $sp = $space;
  ($sp = "R") if ($sp =~ /[rR]/);

  my $data    = $paths{$current}->data;
  ## use the latest fit unless this is a fit and not the head of the
  ## fit branch
  my $to_save = (($paths{$current}->type eq 'fit') and $paths{$current}->get('parent')) ?
    $current :
      $paths{$data.".0"}->get('thisfit');
  my $init    = $paths{$to_save}->descriptor;
  $init =~ s/[.:@&\/\\ ]+/_/g;

  ## take care that file to save exists...
  my $data_file = File::Spec->catfile($project_folder, "fits",
				      $paths{$to_save}->get('folder'),
				      join(".",$data,$suff));
  Error("There is no $kind file for \"".$paths{$data}->descriptor."\""), return
    unless (-e $data_file);

  ## get the file name to save to
  my $save_file = $top -> getSaveFile(-filetypes=>[["$kind files", ".$suff"],
						   ['All Files',   '*'],],
				      ##(not $is_windows) ?
				      ##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				      -initialfile=>$init."_$space.".$suff,
				      -initialdir=> $current_data_dir || cwd,
				      -title => "Artemis: Save $kind");
  return unless ($save_file);

  Echo("Saving $kind in $sp for \"" . $paths{$to_save}->descriptor . "\" ...");
  my $first = "# $kind in $sp for \"" . $paths{$to_save}->descriptor . "\"\n";
  my $to  = File::Spec->catfile($project_folder, "tmp", "outfile");
  my $header_file = File::Spec->catfile($project_folder, "fits", $paths{$to_save}->get('folder'), "header.".$data);
  if (lc($space) eq 'k') {
    open O, ">".$to;
    print O $first;
    do {			# cat the header and the data
      local $| = 1;
      local $/ = undef;
      if (-e $header_file) {
	open H, $header_file;
	print O <H>;
	close H;
      };
      open D, $data_file;
      print O <D>;
      close D;
    };
    close O;
  } elsif ($space =~ /[qr]/i) {
    my $group = $paths{$to_save}->get('group');
    $group =~ s/fit/$suff/;
    my $command = "";
    ## read in this file
    my $infile = $paths{$to_save}->get('fitfile');
    $infile = substr($infile, 0, -3) . $suff;
    $command .= "read_data(file=\"$infile\",\n           type=chi, group=$group)\n";
    ## FT this array
    my $string = "($group.chi, k=$group.k, ";
    foreach (qw(kmin kmax dk kwindow)) {
      $string   .= "$_=" . $paths{$data}->get($_) . ", ";
    };
    $string .= "kweight=" . $plot_features{kweight} . ", ";
    $string .= "rmax_out=" . $plot_features{rmax_out} . ", ";
    if ($paths{$data}->get('pcpath') ne "None") {
      my $pcp  = $paths{$paths{$data}->get('pcpath')}->('fit_index');
      $string .= "pc_feff_path=$pcp, ";
    };
    $string =~ s/, $/\)\n/;
    $string = wrap("fftf", "     ", $string);
    $command .= $string;
    ## do bft for 1 space
    if (lc($space) eq 'q') {
      my $string = "(real=$group.chir_re, imag=$group.chir_im, ";
      foreach (qw(rmin rmax dr rwindow)) {
	$string   .= "$_=" . $paths{$data}->get($_) . ", ";
      };
      $string =~ s/, $/\)\n/;
      $string = wrap("fftr", "     ", $string);
      $command .= $string;
      ## write it to the tmp/ space
      $command .= "\nwrite_data(file=$to,\n           label=\"q chiq_re chiq_im chiq_mag chiq_pha\",\n           $group.q, $group.chiq_re, $group.chiq_im, $group.chiq_mag, $group.chiq_pha)\n";
    } else {
      ## write it to the tmp/ space
      $command .= "\nwrite_data(file=$to,\n           label=\"r chir_re chir_im chir_mag chir_pha\",\n           $group.r, $group.chir_re, $group.chir_im, $group.chir_mag, $group.chir_pha)\n";
    }
    $paths{$to_save}->dispose($command, $dmode);
    do {			# cat the header and the data
      local $| = 1;
      local $/ = undef;
      open D, $to;
      my $d = <D>;
      close D;
      open O, ">".$to;
      print O $first;
      if (-e $header_file) {
	open H, $header_file;
	print O <H>;
	close H;
      };
      print O $d
    };
    close O;
  };
  move($to, $save_file);
  #unlink $to if (-e $to);

  ## finally, reset current_data_dir
  my ($name, $pth, $suffix) = fileparse($save_file);
  $current_data_dir = $pth;
  Echo("Saved $save_file");
};


sub logview_restore_model {
  ## the argument is either the entry number from the list on the log
  ## viewer page (when called from the log viewer) or the id of the
  ## currently anchored path (when called from the menubar)
  my $which = (defined $_[0]) ? $_[0] : $paths{$current};

  my $this;			  # this will be used to set the thisfit
  if (ref($which) =~ /Ifeffit/) { # property of the fit heads
    $this = $which->get('id');
  } else {
    foreach (keys %paths) {
      next unless ($paths{$_}->type eq 'fit');
      next unless  $paths{$_}->get('parent');
      my $lv = dirname($widgets{loglistbox} -> info('data', $which));
      my $ft = File::Spec->catfile($project_folder, 'fits', $paths{$_}->get('folder'));
      next unless same_directory($lv, $ft);
      $this = $_;
    };
  };
  my $from = (ref($which) =~ /Ifeffit/) ?
    File::Spec->catfile($project_folder, 'fits', $which->get('folder'), 'description') :
	File::Spec->catfile(dirname($widgets{loglistbox} -> info('data', $which)), 'description');
  my $to   = File::Spec->catfile($project_folder, 'descriptions', 'artemis');

  my $label = (ref($which) =~ /Ifeffit/) ?
    $which->get('lab') :
      $widgets{loglistbox} -> entrycget($which, '-text');

  ## need to compare from and to, bail if the requested model is the current
  Error("\"$label\" is the current fitting model.  Restore aborted."), return
    if compare($from,$to) == 0;

  $top -> Busy;
  Echo("Restoring fitting model from \"$label\" ...");

  ##@-fp-@   my $bnfr = basename($from);
  ##@-fp-@   my $fp_exists = (-e File::Spec->catfile($bnfr, "...fp"));
  ##@-fp-@   if ($fp_exists) {
  ##@-fp-@     my $is_ok = compare_fingerprint(File::Spec->catfile($bnfr, "...fp"),
  ##@-fp-@ 				    File::Spec->catfile($bnfr, "artemis"));
  ##@-fp-@     unless ($is_ok) {
  ##@-fp-@       my $dialog =
  ##@-fp-@ 	$top -> Dialog(-bitmap         => 'warning',
  ##@-fp-@ 		       -text           => "The fingerprint of the description file for the selected model has changed.  This could indicate that this project file has been tampered with.  It may be unsafe to continue reading this project file.",
  ##@-fp-@ 		       -title          => 'Artemis: Possibly tainted project file...',
  ##@-fp-@ 		       -buttons        => [qw/Continue Abort/],
  ##@-fp-@ 		       -default_button => 'Abort',
  ##@-fp-@ 		       -popover        => 'cursor');
  ##@-fp-@       &posted_Dialog;
  ##@-fp-@       my $response = $dialog->Show();
  ##@-fp-@       if ($response eq 'Abort') {
  ##@-fp-@ 	Echo("Restoring fitting model from \"$label\" ... aborted!");
  ##@-fp-@ 	$top -> Unbusy;
  ##@-fp-@ 	return;
  ##@-fp-@       };
  ##@-fp-@     };
  ##@-fp-@   };

  ## copy this fit's description to the description folder
  Error("Uh oh!  Something went wrong backing up the old description file."),
    return unless copy($to, File::Spec->catfile($project_folder, 'descriptions', 'artemis.bak'));
  Error("Uh oh!  Something went wrong copying the description file for \"$label\"."),
    return unless copy($from, $to);

  ## save the journal
  open J, ">".File::Spec->catfile($project_folder, "descriptions", "journal.artemis");
  print J $notes{journal}->get(qw(1.0 end));
  close J;

  ## discard this fit
  my $save_project_name = $project_name;
  delete_project(1);
  $project_name  = $save_project_name;

  ## read in the description now in the description folder
  open_project($to);
  foreach (keys %paths) {
    next unless ($paths{$_}->type eq 'fit');
    next if $paths{$_}->get('parent');
    $paths{$_} -> make(thisfit=>$this);
  };
  $widgets{log_current} -> configure(-text=>$paths{$this}->get('lab'));
  project_state(0);

  $top -> Unbusy;
  Echo("Restoring fitting model from \"$label\" ... done!");
};

sub display_warnings {
  my $thisfit = $paths{$current}->get('parent')
    ? $current
      : $paths{$current}->get('thisfit');
  my $warnings_file = File::Spec->catfile($project_folder, "fits", $paths{$thisfit}->get('folder'), 'warnings');
  Error("There is no warnings file for this fit"), return
    unless (-e $warnings_file);
  display_file('file', $warnings_file)
};
# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2007 Bruce Ravel
##
## convert a feffit input file (and its include files) into an artemis
## project


sub feffit_convert_input {
  my ($file) = @_;

  my @feffit = ();
  $feffit[0] = {titles=>[], opparams=>{}, path=>[], feffcalcs=>[]};
  my @gds    = ();


  my $pth = $current_data_dir || cwd;
  my $types = [['Feffit input file', '*.inp'],
	       ['All files',         '*'],];
  $file ||= $top -> getOpenFile(-filetypes=>$types,
				##(not $is_windows) ?
				##  (-sortcmd=>sub{$Tk::FBox::a cmp $Tk::FBox::b}) : () ,
				-initialdir=>$pth,
				-title => "Artemis: Open a feffit input file");
  return unless ($file);
  Error("$file does not exist!"), return unless (-e $file);
  my ($name,$path,$suffix) = fileparse($file);

  open *I, $file or die "could not open $file for reading";
  feffit_parse_file(\@feffit, \@gds, $path, *I);
  close *I;
  feffit_finish(\@feffit, \@gds, $path, $file);

  &push_mru($file, 1, "feffit");
  1;
};



sub feffit_parse_file {
  my ($r_feffit, $r_gds, $path, $file) = @_;
  while (<$file>) {
    next if m{^\s*$};		# blank lines
    next if m{^\s*[#!*%]};	# comment lines
    chomp;
    feffit_parse_line($r_feffit, $r_gds, $path, $_);
  };
  return 1;
};


sub feffit_parse_line {
  my ($r_feffit, $r_gds, $path, $line) = @_;

  ## feffit keywords
  my @ignore = qw(format rspout kspout qspout allout bkgfile output);
  my @opparams = qw(bkg data kmin kmax rmin rmax dk dr kw nodegen);
  my $allre = join("|", @ignore, @opparams);
  my $igre  = join("|", @ignore);
  my $opre  = join("|", @opparams);
  my @pathparams = qw(path id e0 s02 sigma2 delr ei third fourth);
  my $ppre = join("|", @pathparams);

  $line =~ s{^\s+}{};		# trim leading blanks
  $line =~ s{\#.*$}{};		# trim trailing comments
  $line =~ s{\s+$}{};		# trim trailing blanks
  $line =~ s{nodegen}{nodegen=1};
  #$line = lc($line);
  my $dataset = $#{$r_feffit};
 LINE: {
    ($line =~ m{\Anext}i) and do {
      ++$dataset;
      $r_feffit->[$dataset] = {titles=>[], opparams=>{}, path=>[], feffcalcs=>[]};
      last LINE;
    };

    ($line =~ m{\Atitle}i) and do {
      $line =~ s{\Atitle\s*[ \t=,]\s*}{}i;
      ## $line now contains the title line, push it onto titles list
      push @{ $r_feffit->[$dataset]->{titles} }, $line;
      last LINE;
    };

    ($line =~ m{\A(?:guess|local|set)}i) and do {
      ## $line now contains the gds line, push it onto gds list
      push @$r_gds, $line;
      last LINE;
    };

    ($line =~ m{^end}i) and do {
      feffit_finish($r_feffit, $r_gds, $path);
      last LINE;
    };

    ($line =~ m{^include}i) and do {
      $line =~ s{\Ainclude\s*[ \t=,]\s*}{}i;
      ## $line now contains the include file, call feffit_parse_file
      my $newfile = File::Spec->catfile($path,$line);
      open *INC, $newfile or die "could not read from $newfile\n";
      feffit_parse_file($r_feffit, $r_gds, $path, *INC);
      close *INC;
      last LINE;
    };

    ($line =~ m{^($ppre)\s*[ \t=,]\s*(\d+)\s*[ \t=,]\s*(.*)}i) and do {
      ## push this path parameter onto its list
      feffit_parse_pathparam($r_feffit, $line);
      last LINE;
    };

    ($line =~ m{^(?:$allre)\s*[ \t=,]\s*}i) and do {
      feffit_parse_opparam($r_feffit, $line, $path);
      last LINE;
    };
  };
};


sub feffit_parse_pathparam {
  my ($r_feffit, $line) = @_;
  $line =~ s{[#!%].*$}{};	# remove end of line comments
  my @pathparams = qw(path id e0 s02 sigma2 delr ei third fourth);
  my $ppre = join("|", @pathparams);
  $line =~ m{^($ppre)\s*[ \t=,]\s*(\d+)\s*[ \t=,]\s*(.*)}i;
  my ($pp, $index, $me) = ($1, $2, $3);
  my $dataset = $#{$r_feffit};
  $r_feffit->[$dataset]->{path}->[$index]->{$pp} = $me;
};

sub feffit_parse_opparam {
  my ($r_feffit, $line, $path) = @_;
  $line =~ s{[#!%].*$}{};	# remove end of line comments
  my @ignore = qw(format rspout kspout qspout allout bkgfile output);
  my @opparams = qw(bkg data kmin kmax rmin rmax dk dr kw);
  my $allre = join("|", @ignore, @opparams);
  my $igre  = join("|", @ignore);
  my $opre  = join("|", @opparams);
  my %words = split(/\s*[ \t=,]\s*/, $line);
  my $dataset = $#{$r_feffit};
  foreach my $key (keys %words) {
    next if (lc($key) =~ m{\A$igre\z}); # ignore some opparams
    ## store the good opparams for this data set
    if (lc($key) eq 'data') {
      my $datafile = File::Spec->catfile($path, $words{$key});
      $r_feffit->[$dataset]->{opparams}->{data} = $datafile;
    } elsif (lc($key) eq 'bkg') {
      if ($r_feffit->[$dataset]->{opparams}->{bkg} =~ m{^[1yt]}) {
	$r_feffit->[$dataset]->{opparams}->{bkg} = 'yes';
      } else {
	$r_feffit->[$dataset]->{opparams}->{bkg} = 'no';
      };
    } else {
      $r_feffit->[$dataset]->{opparams}->{$key} = $words{$key};
    };
  };
};


sub feffit_finish {
  my ($r_feffit, $r_gds, $path, $inpfile) = @_;
  feffit_cull_mkw($r_feffit);
  feffit_find_feffcalcs($r_feffit);

  my %fix = feffit_load_gds($r_gds);
  feffit_load_data($r_feffit, $path);
  feffit_fix_gds(%fix);

  $notes{messages} -> delete(qw(1.0 end));
  use Data::Dumper;
  $notes{messages} -> insert('end', Data::Dumper->Dump([$r_feffit], [qw(*feffit)]));
  $notes{messages} -> insert('end', "\n");
  $notes{messages} -> insert('end', Data::Dumper->Dump([$r_gds], [qw(*gds)]));
  display_file('file', $inpfile) if $inpfile;
  $top -> update;
  raise_palette('messages');
  display_page('data0');
  plot('r', 0);
  Echo("Imported feffit input file");
};


sub feffit_cull_mkw {
  my ($r_feffit) = @_;
  my $first_data = $r_feffit->[0]->{opparams}->{data};
  foreach my $i (1 .. $#{$r_feffit}) {
    my $this_data = $r_feffit->[$i]->{opparams}->{data};
    next if ($this_data ne $first_data);
    my $first_kw = $r_feffit->[0]->{opparams}->{kw};
    $first_kw .= ',' . $r_feffit->[$i]->{opparams}->{kw};
    $r_feffit->[0]->{opparams}->{kw} = $first_kw;
    $r_feffit->[$i] = undef;
  };

};

sub feffit_find_feffcalcs {
  my ($r_feffit) = @_;
  foreach my $set (@$r_feffit) {
    next if not defined($set);
    my %seen;
    my @dirlist;
    my $list = $set->{path};
    my $count = -1;
    foreach my $p (@$list) {
      next if not defined($p);
      my $nnnn = $p->{path};
      next if not defined($nnnn); # take care with path 0
      my $pth = dirname($nnnn);
      $seen{$pth} or push @dirlist, $pth;
      ++$seen{$pth};
    };
    foreach my $feff (@dirlist) {
      push @{$set->{feffcalcs}}, $feff;
    };
  };
};


sub feffit_load_gds {
  my ($r_gds) = @_;
  my %fix = ();
  my $count = 0;
  foreach my $text (@$r_gds) {
    $text =~ s{[#!%].*$}{};	# remove end of line comments
    $text =~ s{\s+$}{};		# trim trailing blanks
    my (@words) = split(/\s*[ \t=,]\s*/, $text);
    my $type = shift @words;
    my $name = shift @words;
    my $me   = join("", @words);
    ## make it a def if it's a math expression and a set if its a number
    if (($type eq 'set') and ($me !~ m{\A[+-]?(?:\d+\.?\d*|\.\d+)\z})) {
      $type = 'def';
    };
    ($type = 'skip') if ($type eq 'local'); # punt for now
    ++$count;
    jump_to_variable(lc($name), $type, 1, $me);
    my $regex = join("|", qw(e0 ei s02 sigma2 third fourth dr dr1 dr2 dk dk1 dk2 etok pi));
    if (lc($name) =~ m{\A($regex)\z}) {
      $fix{lc($name)} = $count;
    };
  };
  return %fix;
  gds2_display(1);
};

sub feffit_fix_gds {
  my %fix = @_;
  my %replacement = ( e0     => 'enot',
		      ei     => 'eimag',
		      s02    => 's_02',
		      sigma2 => 'sigsqr',
		      third  => 'cumul3',
		      fourth => 'cumul4',
		      dr     => 'd_r',
		      dr1    => 'dr_1',
		      dr2    => 'dr_2',
		      dk     => 'd_k',
		      dk1    => 'dk_1',
		      dk2    => 'dk_2',
		      etok   => 'e2k',
		      pi     => 'pie',
		    );
  foreach my $k (keys %fix) {
    gds2_search_replace($fix{$k}, $replacement{$k});
  };
  gds2_display(1);
};


sub feffit_load_data {
  my ($r_feffit, $path) = @_;
  foreach my $set (@$r_feffit) {
    next if not defined($set);
    my $fname = $set->{opparams}->{data};

    ## import the data
    my $group = read_data(0, $fname, 0, 1);

    ## import the operational parameter values and titles
    foreach my $k (qw(kmin kmax rmin rmax dk)) {
      $paths{$group}->make($k=>$set->{opparams}->{$k}) if $k;
    };
    $paths{$group}->make(k1=>1) if ($set->{opparams}->{kw} =~ m{1});
    $paths{$group}->make(k2=>1) if ($set->{opparams}->{kw} =~ m{2});
    $paths{$group}->make(k3=>1) if ($set->{opparams}->{kw} =~ m{3});
    $paths{$group}->make(kwindow=>'Hanning');
    $paths{$group}->make(rwindow=>'Hanning');

    $widgets{op_titles} -> insert('1.0', "\n") if (@{ $set->{titles} });
    foreach my $text (reverse @{ $set->{titles} }) {
      $widgets{op_titles} -> insert('1.0', $text."\n");
    };

    ## import the feff calculations
    my %pathto;
    my $save = $config{autoparams}{do_autoparams};
    $config{autoparams}{do_autoparams} = 0;
    foreach my $dir (@{ $set->{feffcalcs} }) {
      my $feffinp = File::Spec->catfile($path, $dir, "feff.inp");
      my $id = read_feff($feffinp, 1);
      $pathto{$dir} = $id;
    };

    ## import the feff paths and set their path parameters
    my $default = {id=>q{}, s02=>1, e0=>0, delr=>0, sigma2=>0, third=>0, fourth=>0};
    my $pathzero = $set->{path}->[0];
    if (not defined($pathzero)) {
      $pathzero = {id=>q{}, s02=>1, e0=>0, delr=>0, sigma2=>0, third=>0, fourth=>0};
    };
    foreach my $p (@{ $set->{path} }) {
      next if not defined($p);

      my $pth = $p->{path};
      next if not defined($pth); # take care with path 0
      $pth    = dirname($pth);
      my $id  = $pathto{$pth};
      $pth    = $paths{$id}->{path};

      my $nnnn = File::Spec->catfile($pth, basename($p->{path}));
      next if (not -e $nnnn);	# shelly's mkfit will make entries for paths that fail the crits2
      my $key = add_a_path($nnnn, 1, 0);

      $paths{$key}->make('label'   => $p->{id}         || $pathzero->{id}         || $default->{id}    );
      $paths{$key}->make('s02'     => lc($p->{s02})    || lc($pathzero->{s02})    || $default->{s02}   );
      $paths{$key}->make('e0'      => lc($p->{e0})     || lc($pathzero->{e0})     || $default->{e0}    );
      $paths{$key}->make('delr'    => lc($p->{delr})   || lc($pathzero->{delr})   || $default->{delr}  );
      $paths{$key}->make('sigma^2' => lc($p->{sigma2}) || lc($pathzero->{sigma2}) || $default->{sigma2});
      $paths{$key}->make('ei'      => lc($p->{ei})     || lc($pathzero->{ei})     || $default->{ei}    );
      $paths{$key}->make('3rd'     => lc($p->{third})  || lc($pathzero->{third})  || $default->{third} );
      $paths{$key}->make('4th'     => lc($p->{fourth}) || lc($pathzero->{fourth}) || $default->{fourth});

    };

    # respect the nodegen flag
    if ($set->{opparams}->{nodegen}) {
      foreach my $dir (@{ $set->{feffcalcs} }) {
	display_page($pathto{$dir});
	set_degeneracy(1);
      };
    };

    $config{autoparams}{do_autoparams} = $save;

    display_page($group);
  };
};

##  END OF THE SECTION ON FEFFIT CONVERSION

## -*- cperl -*-
##
##  This file is part of Artemis, copyright (c) 2001-2005 Bruce Ravel
##
##  This section of the code initializes all configuration values.
##  This file was generated from the artemis.config file.


sub default_rc {
  my $is_windows = (($^O eq 'MSWin32') or ($^O eq 'cygwin'));


  $_[0]{general}{'query_save'} = 1;
  $_[0]{general}{'autosave_policy'} = "autosave";
  $_[0]{general}{'fit_query'} = 1;
  $_[0]{general}{'sort_sets'} = 1;
  $_[0]{general}{'mru_limit'} = 8;
  $_[0]{general}{'mru_display'} = "full";
  $_[0]{general}{'doc_zoom'} = 4;
  $_[0]{general}{'remember_cwd'} = 0;
  $_[0]{general}{'mac_eol'} = "fix";
  $_[0]{general}{'layout'} = "mlp";
  $_[0]{general}{'projectbar'} = "file";
  $_[0]{general}{'print_spooler'} = ($is_windows) ? "" : "lpr";
  $_[0]{general}{'ps_device'} = "/cps";
  $_[0]{general}{'import_feffit'} = 0;


  $_[0]{geometry}{'window_multiplier'} = ($is_windows) ? 1.0 : 1.07;
  $_[0]{geometry}{'main_width'} = ($is_windows) ? 13.5 : 14;
  $_[0]{geometry}{'main_height'} = ($is_windows) ? 15.5 : 16.5;


  $_[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}{'plot_phase'} = 0;
  $_[0]{plot}{'window_multiplier'} = 1.05;
  $_[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}{'datastyle'} = "solid";
  $_[0]{plot}{'fitstyle'} = "solid";
  $_[0]{plot}{'partsstyle'} = "solid";
  $_[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}{'kweight'} = "2";
  $_[0]{plot}{'plot_win'} = 0;
  $_[0]{plot}{'r_pl'} = "m";
  $_[0]{plot}{'q_pl'} = "r";
  $_[0]{plot}{'nindicators'} = 8;
  $_[0]{plot}{'indicatorcolor'} = "violetred";
  $_[0]{plot}{'indicatorline'} = "solid";


  $_[0]{data}{'fit_space'} = "R";
  $_[0]{data}{'fit_bkg'} = 0;
  $_[0]{data}{'kmin'} = 2;
  $_[0]{data}{'kmax'} = -2;
  $_[0]{data}{'dk'} = 1;
  $_[0]{data}{'kweight'} = 1;
  $_[0]{data}{'rmin'} = 1;
  $_[0]{data}{'rmax'} = 3;
  $_[0]{data}{'dr'} = 0.0;
  $_[0]{data}{'kwindow'} = "hanning";
  $_[0]{data}{'rwindow'} = "hanning";
  $_[0]{data}{'cormin'} = 0.25;
  $_[0]{data}{'bkg_corr'} = "no";
  $_[0]{data}{'rmax_out'} = 10;
  $_[0]{data}{'bkgsub_window'} = 1;


  $_[0]{log}{'style'} = "raw";


  $_[0]{gds}{'start_hidden'} = 0;
  $_[0]{gds}{'guess_color'} = "darkviolet";
  $_[0]{gds}{'def_color'} = "green4";
  $_[0]{gds}{'set_color'} = "black";
  $_[0]{gds}{'skip_color'} = "grey50";
  $_[0]{gds}{'restrain_color'} = "#a300a3";
  $_[0]{gds}{'after_color'} = "skyblue4";
  $_[0]{gds}{'merge_color'} = "red";
  $_[0]{gds}{'merge_background'} = "white";
  $_[0]{gds}{'highlight'} = "darkseagreen1";


  $_[0]{athena}{'parameters'} = "project";


  $_[0]{atoms}{'feff_version'} = "6";
  $_[0]{atoms}{'template'} = "feff";
  $_[0]{atoms}{'absorption_tables'} = "elam";
  $_[0]{atoms}{'elem'} = "entry";


  $_[0]{feff}{'feff_executable'} = ($is_windows) ? "feff6l" : "feff6";


  $_[0]{autoparams}{'do_autoparams'} = 1;
  $_[0]{autoparams}{'data_increment'} = "numbers";
  $_[0]{autoparams}{'s02'} = "amp";
  $_[0]{autoparams}{'s02_type'} = "guess";
  $_[0]{autoparams}{'e0'} = "enot";
  $_[0]{autoparams}{'e0_type'} = "guess";
  $_[0]{autoparams}{'delr'} = "delr";
  $_[0]{autoparams}{'delr_type'} = "guess";
  $_[0]{autoparams}{'sigma2'} = "ss";
  $_[0]{autoparams}{'sigma2_type'} = "guess";
  $_[0]{autoparams}{'ei'} = "";
  $_[0]{autoparams}{'ei_type'} = "def";
  $_[0]{autoparams}{'third'} = "";
  $_[0]{autoparams}{'third_type'} = "def";
  $_[0]{autoparams}{'fourth'} = "";
  $_[0]{autoparams}{'fourth_type'} = "def";


  $_[0]{intrp}{'betamax'} = 20;
  $_[0]{intrp}{'core_token'} = "[+]";
  $_[0]{intrp}{'ss'} = "navajowhite3";
  $_[0]{intrp}{'focus'} = "slategray3";
  $_[0]{intrp}{'excluded'} = "sienna";
  $_[0]{intrp}{'absent'} = "grey50";
  $_[0]{intrp}{'font'} = "Courier 10 bold";
  $_[0]{intrp}{'unimported'} = "Courier 10 italic";


  $_[0]{paths}{'extpp'} = 0;
  $_[0]{paths}{'firstn'} = 10;
  $_[0]{paths}{'label'} = "Path %i: [%p]";


  $_[0]{warnings}{'reff_margin'} = 1.1;
  $_[0]{warnings}{'s02_max'} = 0;
  $_[0]{warnings}{'s02_neg'} = 1;
  $_[0]{warnings}{'e0_max'} = 10;
  $_[0]{warnings}{'dr_max'} = 0.5;
  $_[0]{warnings}{'ss2_max'} = 0;
  $_[0]{warnings}{'ss2_neg'} = 1;
  $_[0]{warnings}{'3rd_max'} = 0;
  $_[0]{warnings}{'4th_max'} = 0;
  $_[0]{warnings}{'ei_max'} = 0;
  $_[0]{warnings}{'dphase_max'} = 0;


  $_[0]{logview}{'prefer'} = "rfactor";
  $_[0]{logview}{'eins_temp_max'} = 1500;
  $_[0]{logview}{'eins_sigma_max'} = 0.03;


  $_[0]{histogram}{'use'} = 0;
  $_[0]{histogram}{'position_column'} = 2;
  $_[0]{histogram}{'height_column'} = 3;
  $_[0]{histogram}{'template'} = "%i: %p (%r)";


  $_[0]{colors}{'check'} = ($is_windows) ? "red2" : "red4";
  $_[0]{colors}{'foreground'} = "black";
  $_[0]{colors}{'background'} = "antiquewhite3";
  $_[0]{colors}{'background2'} = "bisque3";
  $_[0]{colors}{'inactivebackground'} = "antiquewhite3";
  $_[0]{colors}{'activebackground'} = "antiquewhite2";
  $_[0]{colors}{'activebackground2'} = "bisque2";
  $_[0]{colors}{'disabledforeground'} = "grey50";
  $_[0]{colors}{'highlightcolor'} = "blue2";
  $_[0]{colors}{'activehighlightcolor'} = "blue3";
  $_[0]{colors}{'mbutton'} = "darkviolet";
  $_[0]{colors}{'button'} = "red4";
  $_[0]{colors}{'activebutton'} = "brown3";
  $_[0]{colors}{'fitbutton'} = "green4";
  $_[0]{colors}{'activefitbutton'} = "green3";
  $_[0]{colors}{'current'} = "orange2";
  $_[0]{colors}{'selected'} = "lightgoldenrod1";
  $_[0]{colors}{'exclude'} = "sienna";
  $_[0]{colors}{'hidden'} = "darkviolet";
  $_[0]{colors}{'warning_bg'} = "red";
  $_[0]{colors}{'warning_fg'} = "white";


  $_[0]{fonts}{'small'} = ($is_windows) ? "Helvetica 8 normal" : "Helvetica 10 normal";
  $_[0]{fonts}{'smbold'} = ($is_windows) ? "Helvetica 8 bold" : "Helvetica 10 bold";
  $_[0]{fonts}{'med'} = ($is_windows) ? "Helvetica 8 normal" : "Helvetica 12 normal";
  $_[0]{fonts}{'bold'} = ($is_windows) ? "Helvetica 8 bold" : "Helvetica 12 bold";
  $_[0]{fonts}{'bignbold'} = ($is_windows) ? "Helvetica 12 bold" : "Helvetica 14 bold";
  $_[0]{fonts}{'large'} = ($is_windows) ? "Helvetica 12 normal" : "Helvetica 14 normal";
  $_[0]{fonts}{'fixedsm'} = "Courier 12";
  $_[0]{fonts}{'fixed'} = ($is_windows) ? "Courier 12" : "Courier 14";
  $_[0]{fonts}{'fixedit'} = ($is_windows) ? "Courier 12 italic" : "Courier 14 italic";
  $_[0]{fonts}{'fixedbold'} = ($is_windows) ? "Courier 12 bold" : "Courier 14 bold";
  $_[0]{fonts}{'noplot'} = ($is_windows) ? "Helvetica 8 bold italic" : "Helvetica 10 bold italic";


  return 1;
};


## END OF RC FILE SUBSECTION
##########################################################################################
# -*- cperl -*-
##  This file is part of Artemis, copyright (c) 2002-2008 Bruce Ravel
##
## MISCELLANEOUS FUNCTIONALITY FOR ARTEMIS


## 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 get_index {
  if ($_[0] =~ /data(\d+)(_(fit|bkg))?/) {
    return $1;
  } elsif ($_[0] =~ /feff(\d+)(\.\d+)?/) {
    return $1;
  };
  return undef;
};

## tell ifeffit to erase all groups that match $_[0] (e.g. all feff0...)
sub erase_many_groups {
  my $match = $_[0];
  $paths{gsd}->dispose("show \@groups", 1);
  my ($lines, $response) = (Ifeffit::get_scalar('&echo_lines'), "");
  my @list = map {Ifeffit::get_echo()} (1 .. $lines);
  ## print $/, join(" ", @list), $/;
  my $string = "";
  foreach (@list) {
    next unless (/^$match/);
    $string .= "erase \@group $_\n";
  };
  $paths{gsd}->dispose($string, $dmode);
  return 0;
};

sub set_status {
  return if (Ifeffit::Tools->vstr < 1.02007);
  my $val = $_[0] || 0;
  $paths{gsd} -> dispose("set \&status = $val", $dmode);
};


## splice words back together to make a multi-word string that is
## almost, but not quite the same as the original line.  take care to
## drop end of line comments and to replace commas in two argument
## math functions.
sub concat {
  my @list = @_;
  my $string = "";
  while (@list) {
    my $this = shift(@list);
    if ($this =~ /^[%!*\#]/) {
      @list = ();
    } else {
      $string .= " " . $this;
    };
  };
  $string =~ s/^ //;
  $string =~ s/(debye|eins|max|min) ?\((\w+) /$1\($2,/;
  return $string;
};



## multiplexer for renaming list entries, bound to Ctrl-n, on the GDS
## page this is the same as clicking the New button
sub rename_this {
  my $type = $paths{$current}->type;
  &gds2_new,       return if ($type eq 'gsd');
  &rename_fit,     return if (($type eq 'fit') and $paths{$current}->get('parent'));
  Error("You cannot rename the head \"Fit\" entry"),        return if ($type eq 'fit');
  Error("You cannot rename a \"Background\" entry"),        return if ($type eq 'bkg');
  Error("You cannot rename a \"Residual\" entry"),          return if ($type eq 'res');
  Error("You cannot rename a \"Difference\" entry"),        return if ($type eq 'diff');
  &rename_feff(0), return if ($type eq 'feff');
  &rename_path,    return if ($type eq 'path');
  &rename_data,    return if ($type eq 'data');
};

## multiplexer for functionality bound to Ctrl-d
sub keyboard_d {
  gds2_define($widgets{gds2list}, \%gds_selected) if ($current_canvas eq 'gsd');
};
## multiplexer for functionality bound to Ctrl-e
sub keyboard_e {
  if ($current_canvas eq 'gsd') {
    if ($gds_selected{showing} eq 'show') {
      $widgets{gds2_show}->packForget;
      $widgets{gds2_editarea}->pack(-side=>=>'top', -fill=>'x', -padx=>4, -pady=>2);
      $gds_selected{showing}="edit";
    };
  };
};
## multiplexer for functionality bound to Ctrl-g
sub keyboard_g {
  grab_gds2($widgets{gds2list}, \%gds_selected) if ($current_canvas eq 'gsd');
};

## multiplexer for functionality bound to Alt-k
sub keyboard_alt_k {
  if ($current_canvas eq 'gsd') {
    gds2_up();
  } elsif (($current_canvas eq 'feff') and ($fefftabs->raised() eq 'Atoms')) {
    atoms_move('up');
  };
};

## multiplexer for functionality bound to Alt-j
sub keyboard_alt_j {
  if ($current_canvas eq 'gsd') {
    gds2_down();
  } elsif (($current_canvas eq 'feff') and ($fefftabs->raised() eq 'Atoms')) {
    atoms_move('down');
  };
};


## 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);
  $top -> update();
  $ren -> grab();
  $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 and @$r_arrow_buffer) {
    my $pointer = $#{$r_arrow_buffer} + 1;
    $entry->bind("<KeyPress-Up>",	# previous command in history
		 sub{ --$pointer; ($pointer<0) and ($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}) and
			($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',  @button2_list,
		 -font=>$config{fonts}{small},
		 -borderwidth=>1,
		 -width=>10,
		 -command=>[\&restore_echo, $ren, $mode, $entry, $prior])
    -> pack(-side=>'left');
  foreach ($ren, $entry) {
    my $this = $_;
    $this -> bindtags([($this->bindtags)[1,0,2,3]]);
    map {$this -> bind("<Control-$_>" => sub{$this->break;})}
      qw(a h l n o p r s t u v
	 slash period semicolon minus equal
	 Key-1 Key-2 Key-3 Key-4 Key-5 Key-6);
  };

  $entry -> selectionRange(qw(0 end));
  $entry -> icursor('end');
  $top   -> update;
  $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;
  $echo -> pack(-side=>'left', -expand=>1, -fill=>'x', -pady=>2);
  $prior -> focus;
};



## return an nleg value
sub get_nlegs {
  my $d = $top->Dialog(-title   => "Artemis: select paths",
		       -text    => "Maximum number of legs in fit:",
		       -buttons => ["2", "3", "4", "Cancel"],
		       -font    => $config{fonts}{med},
		       -popover => 'cursor');
  my $str = sprintf("+%d+%d", 0.4*$top->screenwidth(), 0.4*$top->screenheight());
  $d -> geometry($str);
  &posted_Dialog;
  my $val = $d -> Show();
  return $d -> Show();
};

## return a value for R_eff
sub get_r {
  my $crit;
  my $label = "Maximum Reff of included paths: ";
  my $dialog = get_string($dmode, $label, \$crit);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Error("Maximum Reff must be a positive number."), return 'Cancel'
    unless ($crit =~/^\s*(\d+\.?\d*|\.\d+)\s*$/);
  return $crit;
};

## return a value for ZCWIF
sub get_zcwif {
  my $crit;
  my $label = "Manimum amplitude for included paths: ";
  my $dialog = get_string($dmode, $label, \$crit);
  $dialog -> waitWindow;	# the get_string dialog will be
                                # destroyed once the user hits ok,
                                # then we can move on...
  Error("An amplitude factor must be a positive number."), return 'Cancel'
    unless ($crit =~/^\s*(\d+\.?\d*|\.\d+)\s*$/);
  return $crit;
};


sub set_fit_button {
 SWITCH: {
    ($_[0] eq 'fit') and do {
      $fit_button -> configure(-state=>'normal', -text=>'Fit',
			       -command=>[\&generate_script, 1]);
      last SWITCH;
    };
    ($_[0] eq 'apa') and do {
      $fit_button -> configure(-state=>'normal', -text=>'Start the Project Assistant',
			       -command=>sub{Echo("Uh oh! APA is not built in anymore")}); #\&apa);
      last SWITCH;
    };
    ($_[0] eq 'disable') and do {
      $fit_button -> configure(-state=>'disabled', -text=>'Fit',);
      last SWITCH;
    };
  };
};


sub layout {
 LAYOUT: {
    ($config{general}{layout} eq 'mlp') and do {
      $fat     -> pack(-side=>'left', -fill=>'y');
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      last LAYOUT;
    };
    ($config{general}{layout} eq 'mpl') and do {
      $fat     -> pack(-side=>'left', -fill=>'y');
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      last LAYOUT;
    };
    ($config{general}{layout} eq 'lmp') and do {
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      $fat     -> pack(-side=>'left', -fill=>'y');
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      last LAYOUT;
    };
    ($config{general}{layout} eq 'lpm') and do {
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      $fat     -> pack(-side=>'left', -fill=>'y');
      last LAYOUT;
    };
    ($config{general}{layout} eq 'pml') and do {
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      $fat     -> pack(-side=>'left', -fill=>'y');
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      last LAYOUT;
    };
    ($config{general}{layout} eq 'plm') and do {
      $skinny2 -> pack(-side=>'left', -fill=>'y');
      $skinny  -> pack(-side=>'left', -expand=>1, -fill=>'both');
      $fat     -> pack(-side=>'left', -fill=>'y');
      last LAYOUT;
    };
  };
};

## convert backslashes to foreward slashes, remove multiple slashes,
## and remove the trailing slash from each string
sub normalize_directory {
  my $a = $_[0];
  $a =~ s/\\+/\//g;		# multiple backslashes
  $a =~ s/\/{2,}/\//g;		# 2 or more foreslashes
  $a =~ s/\/$//;		# trailing slash
  return $a;
};

sub same_directory {
  my ($a, $b) = @_;
  return 0 unless $a;
  return 0 unless $b;
  if ($is_windows) {
    $a=normalize_directory($a);
    $b=normalize_directory($b);
    return ($a eq $b);
  } else {
    my @a = stat $a;		# compare the inodes
    my @b = stat $b;
    return ($a[1] == $b[1]);
  };
};


## is $a a subdirectory of $b, sub_directory("foo/bar", "/foo")
## returns true
sub sub_directory {
  my ($a, $b) = @_;
  return 0 unless $a;
  return 0 unless $b;
  ##print "$a   $b\n";
  $a=normalize_directory($a);
  $b=normalize_directory($b);
  ##print "$a   $b\n";
  return ($a =~ /^$b/);
};


## move rc and mru files from their 0.6.001 and earlier locations to
## the .horae directory
sub convert_config_files {
  my $horae_dir = $setup -> find('artemis', 'horae');
  (-d $horae_dir) or mkpath($horae_dir);
  my $rcfile    = $setup -> find('artemis', 'oldrc');
  my $rctarget  = $setup -> find('artemis', 'rc_personal');
  my $mrufile   = $setup -> find('artemis', 'oldmru');
  my $mrutarget = $setup -> find('artemis', 'mru');
  ##print join(" ", $horae_dir, $rcfile, $rmrufile), $/;
  move($rcfile,  $rctarget)  if (-e $rcfile);
  move($mrufile, $mrutarget) if (-e $mrufile);
};


sub pod_display {
  my $file = $_[0];
  my $p = $top->Pod(-file=>$file);
  $p->zoom_in foreach (1 .. $config{general}{doc_zoom});
};


## display $str in echo area, $app true means to append $str to what
## is already there
sub Echo {
  my ($string, $append) = @_;
  my ($bg, $fn, $bt) = ($config{colors}{background},
			$config{fonts}{small},
			$config{colors}{button});
  $ebar -> configure(-background => $bg);
  $echo -> configure(-font       => $fn,
		     -foreground => $bt,
		     -background => $bg);
  return unless $string;
  ($append) and ($string = $echo -> cget('-text') . $string);
  $echo -> configure(-text=>(length($string) > 137) ? substr($string, 0, 137) : $string);
  ## push @echo_history, $string;
  ## ($#echo_history > 2000) and shift @echo_history;

  ## next line corrects a hierarchy problem on windows
  my $widg = (ref($notes{echo}) =~ m{Frame}) ? $notes{echo}->Subwidget('rotext') : $notes{echo};
  $widg -> insert('end', $string."\n");
  $widg -> yviewMoveto(1);
  $top -> update;
};
sub Running {
  Echo(@_);
  ## bold white on green
  my ($bg, $fn, $bt) = ($config{colors}{fitbutton}, $config{fonts}{smbold}, $config{colors}{warning_fg});
  $ebar -> configure(-background => $bg);
  $echo -> configure(-font       => $fn,
		     -foreground => $bt,
		     -background => $bg);
  $top -> update;
};
sub Attention {
  Echo(@_);
  ## bold white on red
  my ($bg, $fn, $bt) = ($config{colors}{warning_bg}, $config{fonts}{smbold}, $config{colors}{warning_fg});
  $ebar -> configure(-background => $bg);
  $echo -> configure(-font       => $fn,
		     -foreground => $bt,
		     -background => $bg);
  $top -> update;
};
sub Echo_nosave {
  my ($string, $append) = @_;
  return unless $string;
  ($append) and ($string = $echo -> cget('-text') . $string);
  $echo -> configure(-text=>$string);
  $top -> update;
};

sub Error {
  $top -> bell;
  Echo(@_);
};

sub posted_Dialog {
  Attention("You must respond to the posted dialog.  (These dialogs sometimes get hidden beneath other windows.)");
};

sub show_hint {
  Echo("Hints file was not found"), return unless @hints;
  $hint_n = int(rand $hint_x);
  Echo("HINT: " . $hints[$hint_n]);
  #++$hint_n;
  #($hint_n > $#hints) and $hint_n = 0;
};

sub track {
  no warnings;
  my %hash = %{ $_[0] };
  my @caller = caller(1);
  my $called_from = $caller[3];
  print "-" x 60, $/;
  print "called from: $called_from\n";
  foreach (keys %hash) {
    if (ref($hash{$_}) =~ /CODE/) {
      print &{ $hash{$_} };
    } else {
      print "$_ : $hash{$_}\n";
    };
  };
};

sub dump_paths {
  Echo("Dumping paths to \`artemis.dump\'");
  $Data::Dumper::Indent = 2;
  ##read_gds2(0);
  read_titles;
  $paths{journal} = $notes{journal}->get(qw(1.0 end));
  open DUMP, ">artemis.dump" or die $!;
  print DUMP Data::Dumper->Dump([\%paths], [qw/paths/]);
  print DUMP Data::Dumper->Dump([\%temp], [qw/temp/]);
  close DUMP;
  delete $paths{journal};
  $Data::Dumper::Indent = 0;
  Echo(@done);
};

sub swap_panels {
  Error("Swapping panels is temporarily disabled.");
  ##   if (grep {$_ eq 'right'} ($skinny -> packInfo())) {
  ##     $skinny -> pack(-side=>'left');
  ##     $list   -> configure(-scrollbars=>'w');
  ##   } else {
  ##     $skinny -> pack(-side=>'right');
  ##     $list   -> configure(-scrollbars=>'e');
  ##   };
};

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; });
  };
};


## respond to a mouse-3 event in the paths list by posting the
## context-appropriate menu
sub list_mouse_menu {
  return if ($list->entrycget('gsd', '-state') eq 'disabled');
  &anchor_display;
  my ($X, $Y) = @_;
 SWITCH: {
    $menubar -> Post($X, $Y, 4), last SWITCH if
      ($paths{$current}->{type} eq 'gsd');
    $menubar -> Post($X, $Y, 5), last SWITCH if
      ($paths{$current}->{type} =~ /(bkg|data|res)/);
    $menubar -> Post($X, $Y, 7), last SWITCH if
      ($paths{$current}->{type} eq 'fit');
    $menubar -> Post($X, $Y, 8), last SWITCH if
      ($paths{$current}->{type} eq 'feff');
    $menubar -> Post($X, $Y, 9), last SWITCH if
      ($paths{$current}->{type} eq 'path');
  };
}



sub quit_artemis {
  if ($config{general}{query_save} and !$project_saved) {
    my $dialog =
      $top -> Dialog(-bitmap         => 'questhead',
		     -text           => "Would you like to save this project before exiting?",
		     -title          => 'Artemis: Exiting...',
		     -buttons        => [qw/Yes No Cancel/],
		     -default_button => 'Yes',
		     -font           => $config{fonts}{med},
		     -popover        => 'cursor');
    &posted_Dialog;
    my $response = $dialog->Show();
    Echo("Not quitting."), return if ($response eq 'Cancel');
    Echo("Preparing to quit ...");
    ($response eq 'Yes') and &save_project('all',0);
  };
  SWITCH: {
      $opparams	-> packForget(), last SWITCH if ($current_canvas eq 'op');
      $gsd	-> packForget(), last SWITCH if ($current_canvas eq 'gsd');
      $feff	-> packForget(), last SWITCH if ($current_canvas eq 'feff');
      $path	-> packForget(), last SWITCH if ($current_canvas eq 'path');
    };
  $top  -> update;
  ## clean up project directory
  (-d $project_folder) and rmtree($project_folder);
  ## delete autosave file
  unlink $autosave_filename if (-e $autosave_filename);
  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;

  $mru{config}{last_working_directory} = $current_data_dir;

  ## remember the geometry, save it in the mru file
  my ($width, $height, $x, $y) = split(/[x+]/, $top->geometry);
  $mru{geometry}{height} = $height;
  $mru{geometry}{width}  = $width;
  $mru{geometry}{'x'}    = $x;
  $mru{geometry}{'y'}    = $y;
  ($width, $height, $x, $y) = split(/[x+]/, $update->geometry);
  $mru{geometry}{uheight} = $height;
  $mru{geometry}{uwidth}  = $width;
  $mru{geometry}{'ux'}    = $x;
  $mru{geometry}{'uy'}    = $y;
  tied(%mru) -> WriteConfig($mrufile);


  ## bye bye!
  $top->destroy();
  exit;
};

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;
}

1;
